Annotation of embedaddon/curl/docs/cmdline-opts/gen.pl, revision 1.1.1.1

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>