docs/cmdline-opts/gen.pl

   1 #!/usr/bin/perl
   2
   3 =begin comment
   4
   5 This script generates the manpage.
   6
   7 Example: gen.pl mainpage > curl.1
   8
   9 Dev notes:
  10
  11 We open *input* files in :crlf translation (a no-op on many platforms) in
  12 case we have CRLF line endings in Windows but a perl that defaults to LF.
  13 Unfortunately it seems some perls like msysgit can't handle a global input-only
  14 :crlf so it has to be specified on each file open for text input.
  15
  16 =end comment
  17 =cut
  18
  19 my $some_dir=$ARGV[1] || ".";
  20
  21 opendir(my $dh, $some_dir) || die "Can't opendir $some_dir: $!";
  22 my @s = grep { /\.d$/ && -f "$some_dir/$_" } readdir($dh);
  23 closedir $dh;
  24
  25 my %optshort;
  26 my %optlong;
  27 my %helplong;
  28 my %arglong;
  29 my %redirlong;
  30 my %protolong;
  31
  32 # get the long name version, return the man page string
  33 sub manpageify {
  34     my ($k)=@_;
  35     my $l;
  36     if($optlong{$k} ne "") {
  37         # both short + long
  38         $l = "\\fI-".$optlong{$k}.", --$k\\fP";
  39     }
  40     else {
  41         # only long
  42         $l = "\\fI--$k\\fP";
  43     }
  44     return $l;
  45 }
  46
  47 sub printdesc {
  48     my @desc = @_;
  49     for my $d (@desc) {
  50         # skip lines starting with space (examples)
  51         if($d =~ /^[^ ]/) {
  52             for my $k (keys %optlong) {
  53                 my $l = manpageify($k);
  54                 $d =~ s/--$k([^a-z0-9_-])/$l$1/;
  55             }
  56         }
  57         print $d;
  58     }
  59 }
  60
  61 sub seealso {
  62     my($standalone, $data)=@_;
  63     if($standalone) {
  64         return sprintf
  65             ".SH \"SEE ALSO\"\n$data\n";
  66     }
  67     else {
  68         return "See also $data. ";
  69     }
  70 }
  71
  72 sub overrides {
  73     my ($standalone, $data)=@_;
  74     if($standalone) {
  75         return ".SH \"OVERRIDES\"\n$data\n";
  76     }
  77     else {
  78         return $data;
  79     }
  80 }
  81
  82 sub protocols {
  83     my ($standalone, $data)=@_;
  84     if($standalone) {
  85         return ".SH \"PROTOCOLS\"\n$data\n";
  86     }
  87     else {
  88         return "($data) ";
  89     }
  90 }
  91
  92 sub added {
  93     my ($standalone, $data)=@_;
  94     if($standalone) {
  95         return ".SH \"ADDED\"\nAdded in curl version $data\n";
  96     }
  97     else {
  98         return "Added in $data. ";
  99     }
 100 }
 101
 102 sub single {
 103     my ($f, $standalone)=@_;
 104     open(F, "<:crlf", "$some_dir/$f") ||
 105         return 1;
 106     my $short;
 107     my $long;
 108     my $tags;
 109     my $added;
 110     my $protocols;
 111     my $arg;
 112     my $mutexed;
 113     my $requires;
 114     my $seealso;
 115     my $magic; # cmdline special option
 116     while(<F>) {
 117         if(/^Short: *(.)/i) {
 118             $short=$1;
 119         }
 120         elsif(/^Long: *(.*)/i) {
 121             $long=$1;
 122         }
 123         elsif(/^Added: *(.*)/i) {
 124             $added=$1;
 125         }
 126         elsif(/^Tags: *(.*)/i) {
 127             $tags=$1;
 128         }
 129         elsif(/^Arg: *(.*)/i) {
 130             $arg=$1;
 131         }
 132         elsif(/^Magic: *(.*)/i) {
 133             $magic=$1;
 134         }
 135         elsif(/^Mutexed: *(.*)/i) {
 136             $mutexed=$1;
 137         }
 138         elsif(/^Protocols: *(.*)/i) {
 139             $protocols=$1;
 140         }
 141         elsif(/^See-also: *(.*)/i) {
 142             $seealso=$1;
 143         }
 144         elsif(/^Requires: *(.*)/i) {
 145             $requires=$1;
 146         }
 147         elsif(/^Help: *(.*)/i) {
 148             ;
 149         }
 150         elsif(/^---/) {
 151             if(!$long) {
 152                 print STDERR "WARN: no 'Long:' in $f\n";
 153             }
 154             last;
 155         }
 156         else {
 157             chomp;
 158             print STDERR "WARN: unrecognized line in $f, ignoring:\n:'$_';"
 159         }
 160     }
 161     my @dest;
 162     while(<F>) {
 163         push @desc, $_;
 164     }
 165     close(F);
 166     my $opt;
 167     if(defined($short) && $long) {
 168         $opt = "-$short, --$long";
 169     }
 170     elsif($short && !$long) {
 171         $opt = "-$short";
 172     }
 173     elsif($long && !$short) {
 174         $opt = "--$long";
 175     }
 176
 177     if($arg) {
 178         $opt .= " $arg";
 179     }
 180
 181     if($standalone) {
 182         print ".TH curl 1 \"30 Nov 2016\" \"curl 7.52.0\" \"curl manual\"\n";
 183         print ".SH OPTION\n";
 184         print "curl $opt\n";
 185     }
 186     else {
 187         print ".IP \"$opt\"\n";
 188     }
 189     if($protocols) {
 190         print protocols($standalone, $protocols);
 191     }
 192
 193     if($standalone) {
 194         print ".SH DESCRIPTION\n";
 195     }
 196
 197     printdesc(@desc);
 198     undef @desc;
 199
 200     my @foot;
 201     if($seealso) {
 202         my @m=split(/ /, $seealso);
 203         my $mstr;
 204         for my $k (@m) {
 205             my $l = manpageify($k);
 206             $mstr .= sprintf "%s$l", $mstr?" and ":"";
 207         }
 208         push @foot, seealso($standalone, $mstr);
 209     }
 210     if($requires) {
 211         my $l = manpageify($long);
 212         push @foot, "$l requires that the underlying libcurl".
 213             " was built to support $requires. ";
 214     }
 215     if($mutexed) {
 216         my @m=split(/ /, $mutexed);
 217         my $mstr;
 218         for my $k (@m) {
 219             my $l = manpageify($k);
 220             $mstr .= sprintf "%s$l", $mstr?" and ":"";
 221         }
 222         push @foot, overrides($standalone, "This option overrides $mstr. ");
 223     }
 224     if($added) {
 225         push @foot, added($standalone, $added);
 226     }
 227     if($foot[0]) {
 228         print "\n";
 229         my $f = join("", @foot);
 230         $f =~ s/ +\z//; # remove trailing space
 231         print "$f\n";
 232     }
 233     return 0;
 234 }
 235
 236 sub getshortlong {
 237     my ($f)=@_;
 238     open(F, "<:crlf", "$some_dir/$f");
 239     my $short;
 240     my $long;
 241     my $help;
 242     my $arg;
 243     my $protocols;
 244     while(<F>) {
 245         if(/^Short: (.)/i) {
 246             $short=$1;
 247         }
 248         elsif(/^Long: (.*)/i) {
 249             $long=$1;
 250         }
 251         elsif(/^Help: (.*)/i) {
 252             $help=$1;
 253         }
 254         elsif(/^Arg: (.*)/i) {
 255             $arg=$1;
 256         }
 257         elsif(/^Protocols: (.*)/i) {
 258             $protocols=$1;
 259         }
 260         elsif(/^---/) {
 261             last;
 262         }
 263     }
 264     close(F);
 265     if($short) {
 266         $optshort{$short}=$long;
 267     }
 268     if($long) {
 269         $optlong{$long}=$short;
 270         $helplong{$long}=$help;
 271         $arglong{$long}=$arg;
 272         $protolong{$long}=$protocols;
 273     }
 274 }
 275
 276 sub indexoptions {
 277   foreach my $f (@s) {
 278     getshortlong($f);
 279   }
 280 }
 281
 282 sub header {
 283     my ($f)=@_;
 284     open(F, "<:crlf", "$some_dir/$f");
 285     my @d;
 286     while(<F>) {
 287         push @d, $_;
 288     }
 289     close(F);
 290     printdesc(@d);
 291 }
 292
 293 sub listhelp {
 294     foreach my $f (sort keys %helplong) {
 295         my $long = $f;
 296         my $short = $optlong{$long};
 297         my $opt;
 298
 299         if(defined($short) && $long) {
 300             $opt = "-$short, --$long";
 301         }
 302         elsif($long && !$short) {
 303             $opt = "    --$long";
 304         }
 305
 306         my $arg = $arglong{$long};
 307         if($arg) {
 308             $opt .= " $arg";
 309         }
 310
 311         my $line = sprintf " %-19s %s\n", $opt, $helplong{$f};
 312
 313         if(length($line) > 79) {
 314             print STDERR "WARN: the --$long line is too long\n";
 315         }
 316         print $line;
 317     }
 318 }
 319
 320 sub mainpage {
 321     # show the page header
 322     header("page-header");
 323
 324     # output docs for all options
 325     foreach my $f (sort @s) {
 326         single($f, 0);
 327     }
 328
 329     header("page-footer");
 330 }
 331
 332 sub showonly {
 333     my ($f) = @_;
 334     if(single($f, 1)) {
 335         print STDERR "$f: failed\n";
 336     }
 337 }
 338
 339 sub showprotocols {
 340     my %prots;
 341     foreach my $f (keys %optlong) {
 342         my @p = split(/ /, $protolong{$f});
 343         for my $p (@p) {
 344             $prots{$p}++;
 345         }
 346     }
 347     for(sort keys %prots) {
 348         printf "$_ (%d options)\n", $prots{$_};
 349     }
 350 }
 351
 352 sub getargs {
 353     my $f;
 354     do {
 355         $f = shift @ARGV;
 356         if($f eq "mainpage") {
 357             mainpage();
 358             return;
 359         }
 360         elsif($f eq "listhelp") {
 361             listhelp();
 362             return;
 363         }
 364         elsif($f eq "single") {
 365             showonly(shift @ARGV);
 366             return;
 367         }
 368         elsif($f eq "protos") {
 369             showprotocols();
 370             return;
 371         }
 372     } while($f);
 373
 374     print "Usage: gen.pl <mainpage/listhelp/single FILE/protos> [srcdir]\n";
 375 }
 376
 377 #------------------------------------------------------------------------
 378
 379 # learn all existing options
 380 indexoptions();
 381
 382 getargs();
 383