• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
1#!/usr/bin/env perl
2#***************************************************************************
3#                                  _   _ ____  _
4#  Project                     ___| | | |  _ \| |
5#                             / __| | | | |_) | |
6#                            | (__| |_| |  _ <| |___
7#                             \___|\___/|_| \_\_____|
8#
9# Copyright (C) 1998 - 2021, 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.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
26This script generates the manpage.
27
28Example: gen.pl <command> [files] > curl.1
29
30Dev notes:
31
32We open *input* files in :crlf translation (a no-op on many platforms) in
33case we have CRLF line endings in Windows but a perl that defaults to LF.
34Unfortunately 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
40my %optshort;
41my %optlong;
42my %helplong;
43my %arglong;
44my %redirlong;
45my %protolong;
46my %catlong;
47
48use POSIX qw(strftime);
49my $date = strftime "%B %d %Y", localtime;
50my $year = strftime "%Y", localtime;
51my $version = "unknown";
52
53open(INC, "<../../include/curl/curlver.h");
54while(<INC>) {
55    if($_ =~ /^#define LIBCURL_VERSION \"([0-9.]*)/) {
56        $version = $1;
57        last;
58    }
59}
60close(INC);
61
62# get the long name version, return the man page string
63sub manpageify {
64    my ($k)=@_;
65    my $l;
66    if($optlong{$k} ne "") {
67        # both short + long
68        $l = "\\fI-".$optlong{$k}.", --$k\\fP";
69    }
70    else {
71        # only long
72        $l = "\\fI--$k\\fP";
73    }
74    return $l;
75}
76
77sub printdesc {
78    my @desc = @_;
79    for my $d (@desc) {
80        if($d =~ /\(Added in ([0-9.]+)\)/i) {
81            my $ver = $1;
82            if(too_old($ver)) {
83                $d =~ s/ *\(Added in $ver\)//gi;
84            }
85        }
86        if($d !~ /^.\\"/) {
87            # **bold**
88            $d =~ s/\*\*([^ ]*)\*\*/\\fB$1\\fP/g;
89            # *italics*
90            $d =~ s/\*([^ ]*)\*/\\fI$1\\fP/g;
91        }
92        # skip lines starting with space (examples)
93        if($d =~ /^[^ ]/) {
94            for my $k (keys %optlong) {
95                my $l = manpageify($k);
96                $d =~ s/--$k([^a-z0-9_-])/$l$1/;
97            }
98        }
99        # quote "bare" minuses in the output
100        $d =~ s/( |\\fI|^)--/$1\\-\\-/g;
101        $d =~ s/([ -]|\\fI|^)-/$1\\-/g;
102        # handle single quotes first on the line
103        $d =~ s/(\s*)\'/$1\\(aq/;
104        print $d;
105    }
106}
107
108sub seealso {
109    my($standalone, $data)=@_;
110    if($standalone) {
111        return sprintf
112            ".SH \"SEE ALSO\"\n$data\n";
113    }
114    else {
115        return "See also $data. ";
116    }
117}
118
119sub overrides {
120    my ($standalone, $data)=@_;
121    if($standalone) {
122        return ".SH \"OVERRIDES\"\n$data\n";
123    }
124    else {
125        return $data;
126    }
127}
128
129sub protocols {
130    my ($standalone, $data)=@_;
131    if($standalone) {
132        return ".SH \"PROTOCOLS\"\n$data\n";
133    }
134    else {
135        return "($data) ";
136    }
137}
138
139sub too_old {
140    my ($version)=@_;
141    my $a = 999999;
142    if($version =~ /^(\d+)\.(\d+)\.(\d+)/) {
143        $a = $1 * 1000 + $2 * 10 + $3;
144    }
145    elsif($version =~ /^(\d+)\.(\d+)/) {
146        $a = $1 * 1000 + $2 * 10;
147    }
148    if($a < 7300) {
149        # we consider everything before 7.30.0 to be too old to mention
150        # specific changes for
151        return 1;
152    }
153    return 0;
154}
155
156sub added {
157    my ($standalone, $data)=@_;
158    if(too_old($data)) {
159        # don't mention ancient additions
160        return "";
161    }
162    if($standalone) {
163        return ".SH \"ADDED\"\nAdded in curl version $data\n";
164    }
165    else {
166        return "Added in $data. ";
167    }
168}
169
170sub single {
171    my ($f, $standalone)=@_;
172    open(F, "<:crlf", "$f") ||
173        return 1;
174    my $short;
175    my $long;
176    my $tags;
177    my $added;
178    my $protocols;
179    my $arg;
180    my $mutexed;
181    my $requires;
182    my $category;
183    my $seealso;
184    my @examples; # there can be more than one
185    my $magic; # cmdline special option
186    my $line;
187    while(<F>) {
188        $line++;
189        if(/^Short: *(.)/i) {
190            $short=$1;
191        }
192        elsif(/^Long: *(.*)/i) {
193            $long=$1;
194        }
195        elsif(/^Added: *(.*)/i) {
196            $added=$1;
197        }
198        elsif(/^Tags: *(.*)/i) {
199            $tags=$1;
200        }
201        elsif(/^Arg: *(.*)/i) {
202            $arg=$1;
203        }
204        elsif(/^Magic: *(.*)/i) {
205            $magic=$1;
206        }
207        elsif(/^Mutexed: *(.*)/i) {
208            $mutexed=$1;
209        }
210        elsif(/^Protocols: *(.*)/i) {
211            $protocols=$1;
212        }
213        elsif(/^See-also: *(.*)/i) {
214            $seealso=$1;
215        }
216        elsif(/^Requires: *(.*)/i) {
217            $requires=$1;
218        }
219        elsif(/^Category: *(.*)/i) {
220            $category=$1;
221        }
222        elsif(/^Example: *(.*)/i) {
223            push @examples, $1;
224        }
225        elsif(/^Help: *(.*)/i) {
226            ;
227        }
228        elsif(/^---/) {
229            if(!$long) {
230                print STDERR "ERROR: no 'Long:' in $f\n";
231                exit 1;
232            }
233            if(!$category) {
234                print STDERR "ERROR: no 'Category:' in $f\n";
235                exit 2;
236            }
237            if(!$examples[0]) {
238                print STDERR "$f:$line:1:ERROR: no 'Example:' present\n";
239                exit 2;
240            }
241            if(!$added) {
242                print STDERR "$f:$line:1:ERROR: no 'Added:' version present\n";
243                exit 2;
244            }
245            last;
246        }
247        else {
248            chomp;
249            print STDERR "WARN: unrecognized line in $f, ignoring:\n:'$_';"
250        }
251    }
252    my @desc;
253    while(<F>) {
254        push @desc, $_;
255    }
256    close(F);
257    my $opt;
258    if(defined($short) && $long) {
259        $opt = "-$short, --$long";
260    }
261    elsif($short && !$long) {
262        $opt = "-$short";
263    }
264    elsif($long && !$short) {
265        $opt = "--$long";
266    }
267
268    if($arg) {
269        $opt .= " $arg";
270    }
271
272    # quote "bare" minuses in opt
273    $opt =~ s/( |^)--/$1\\-\\-/g;
274    $opt =~ s/( |^)-/$1\\-/g;
275    if($standalone) {
276        print ".TH curl 1 \"30 Nov 2016\" \"curl 7.52.0\" \"curl manual\"\n";
277        print ".SH OPTION\n";
278        print "curl $opt\n";
279    }
280    else {
281        print ".IP \"$opt\"\n";
282    }
283    if($protocols) {
284        print protocols($standalone, $protocols);
285    }
286
287    if($standalone) {
288        print ".SH DESCRIPTION\n";
289    }
290
291    printdesc(@desc);
292    undef @desc;
293
294    my @foot;
295    if($seealso) {
296        my @m=split(/ /, $seealso);
297        my $mstr;
298        my $and = 0;
299        my $num = scalar(@m);
300        if($num > 2) {
301            # use commas up to this point
302            $and = $num - 1;
303        }
304        my $i = 0;
305        for my $k (@m) {
306            if(!$helplong{$k}) {
307                print STDERR "WARN: $f see-alsos a non-existing option: $k\n";
308            }
309            my $l = manpageify($k);
310            my $sep = " and";
311            if($and && ($i < $and)) {
312                $sep = ",";
313            }
314            $mstr .= sprintf "%s$l", $mstr?"$sep ":"";
315            $i++;
316        }
317        push @foot, seealso($standalone, $mstr);
318    }
319    if($requires) {
320        my $l = manpageify($long);
321        push @foot, "$l requires that the underlying libcurl".
322            " was built to support $requires. ";
323    }
324    if($mutexed) {
325        my @m=split(/ /, $mutexed);
326        my $mstr;
327        for my $k (@m) {
328            if(!$helplong{$k}) {
329                print STDERR "WARN: $f mutexes a non-existing option: $k\n";
330            }
331            my $l = manpageify($k);
332            $mstr .= sprintf "%s$l", $mstr?" and ":"";
333        }
334        push @foot, overrides($standalone, "This option overrides $mstr. ");
335    }
336    if($examples[0]) {
337        my $s ="";
338        $s="s" if($examples[1]);
339        print "\nExample$s:\n.nf\n";
340        foreach my $e (@examples) {
341            $e =~ s!\$URL!https://example.com!g;
342            print " curl $e\n";
343        }
344        print ".fi\n";
345    }
346    if($added) {
347        push @foot, added($standalone, $added);
348    }
349    if($foot[0]) {
350        print "\n";
351        my $f = join("", @foot);
352        $f =~ s/ +\z//; # remove trailing space
353        print "$f\n";
354    }
355    return 0;
356}
357
358sub getshortlong {
359    my ($f)=@_;
360    open(F, "<:crlf", "$f");
361    my $short;
362    my $long;
363    my $help;
364    my $arg;
365    my $protocols;
366    my $category;
367    while(<F>) {
368        if(/^Short: (.)/i) {
369            $short=$1;
370        }
371        elsif(/^Long: (.*)/i) {
372            $long=$1;
373        }
374        elsif(/^Help: (.*)/i) {
375            $help=$1;
376        }
377        elsif(/^Arg: (.*)/i) {
378            $arg=$1;
379        }
380        elsif(/^Protocols: (.*)/i) {
381            $protocols=$1;
382        }
383        elsif(/^Category: (.*)/i) {
384            $category=$1;
385        }
386        elsif(/^---/) {
387            last;
388        }
389    }
390    close(F);
391    if($short) {
392        $optshort{$short}=$long;
393    }
394    if($long) {
395        $optlong{$long}=$short;
396        $helplong{$long}=$help;
397        $arglong{$long}=$arg;
398        $protolong{$long}=$protocols;
399        $catlong{$long}=$category;
400    }
401}
402
403sub indexoptions {
404    my (@files) = @_;
405    foreach my $f (@files) {
406        getshortlong($f);
407    }
408}
409
410sub header {
411    my ($f)=@_;
412    open(F, "<:crlf", "$f");
413    my @d;
414    while(<F>) {
415        s/%DATE/$date/g;
416        s/%VERSION/$version/g;
417        push @d, $_;
418    }
419    close(F);
420    printdesc(@d);
421}
422
423sub listhelp {
424    print <<HEAD
425/***************************************************************************
426 *                                  _   _ ____  _
427 *  Project                     ___| | | |  _ \\| |
428 *                             / __| | | | |_) | |
429 *                            | (__| |_| |  _ <| |___
430 *                             \\___|\\___/|_| \\_\\_____|
431 *
432 * Copyright (C) 1998 - $year, Daniel Stenberg, <daniel@haxx.se>, et al.
433 *
434 * This software is licensed as described in the file COPYING, which
435 * you should have received as part of this distribution. The terms
436 * are also available at https://curl.se/docs/copyright.html.
437 *
438 * You may opt to use, copy, modify, merge, publish, distribute and/or sell
439 * copies of the Software, and permit persons to whom the Software is
440 * furnished to do so, under the terms of the COPYING file.
441 *
442 * This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
443 * KIND, either express or implied.
444 *
445 ***************************************************************************/
446#include "tool_setup.h"
447#include "tool_help.h"
448
449/*
450 * DO NOT edit tool_listhelp.c manually.
451 * This source file is generated with the following command:
452
453  cd \$srcroot/docs/cmdline-opts
454  ./gen.pl listhelp *.d > \$srcroot/src/tool_listhelp.c
455 */
456
457const struct helptxt helptext[] = {
458HEAD
459        ;
460    foreach my $f (sort keys %helplong) {
461        my $long = $f;
462        my $short = $optlong{$long};
463        my @categories = split ' ', $catlong{$long};
464        my $bitmask;
465        my $opt;
466
467        if(defined($short) && $long) {
468            $opt = "-$short, --$long";
469        }
470        elsif($long && !$short) {
471            $opt = "    --$long";
472        }
473        for my $i (0 .. $#categories) {
474            $bitmask .= 'CURLHELP_' . uc $categories[$i];
475            # If not last element, append |
476            if($i < $#categories) {
477                $bitmask .= ' | ';
478            }
479        }
480        my $arg = $arglong{$long};
481        if($arg) {
482            $opt .= " $arg";
483        }
484        my $desc = $helplong{$f};
485        $desc =~ s/\"/\\\"/g; # escape double quotes
486
487        my $line = sprintf "  {\"%s\",\n   \"%s\",\n   %s},\n", $opt, $desc, $bitmask;
488
489        if(length($opt) > 78) {
490            print STDERR "WARN: the --$long name is too long\n";
491        }
492        elsif(length($desc) > 78) {
493            print STDERR "WARN: the --$long description is too long\n";
494        }
495        print $line;
496    }
497    print <<FOOT
498  { NULL, NULL, CURLHELP_HIDDEN }
499};
500FOOT
501        ;
502}
503
504sub listcats {
505    my %allcats;
506    foreach my $f (sort keys %helplong) {
507        my @categories = split ' ', $catlong{$f};
508        foreach (@categories) {
509            $allcats{$_} = undef;
510        }
511    }
512    my @categories;
513    foreach my $key (keys %allcats) {
514        push @categories, $key;
515    }
516    @categories = sort @categories;
517    unshift @categories, 'hidden';
518    for my $i (0..$#categories) {
519        print '#define ' . 'CURLHELP_' . uc($categories[$i]) . ' ' . "1u << " . $i . "u\n";
520    }
521}
522
523sub mainpage {
524    my (@files) = @_;
525    # show the page header
526    header("page-header");
527
528    # output docs for all options
529    foreach my $f (sort @files) {
530        if(single($f, 0)) {
531            print STDERR "Can't read $f?\n";
532        }
533    }
534
535    header("page-footer");
536}
537
538sub showonly {
539    my ($f) = @_;
540    if(single($f, 1)) {
541        print STDERR "$f: failed\n";
542    }
543}
544
545sub showprotocols {
546    my %prots;
547    foreach my $f (keys %optlong) {
548        my @p = split(/ /, $protolong{$f});
549        for my $p (@p) {
550            $prots{$p}++;
551        }
552    }
553    for(sort keys %prots) {
554        printf "$_ (%d options)\n", $prots{$_};
555    }
556}
557
558sub getargs {
559    my ($f, @s) = @_;
560    if($f eq "mainpage") {
561        mainpage(@s);
562        return;
563    }
564    elsif($f eq "listhelp") {
565        listhelp();
566        return;
567    }
568    elsif($f eq "single") {
569        showonly($s[0]);
570        return;
571    }
572    elsif($f eq "protos") {
573        showprotocols();
574        return;
575    }
576    elsif($f eq "listcats") {
577        listcats();
578        return;
579    }
580
581    print "Usage: gen.pl <mainpage/listhelp/single FILE/protos/listcats> [files]\n";
582}
583
584#------------------------------------------------------------------------
585
586my $cmd = shift @ARGV;
587my @files = @ARGV; # the rest are the files
588
589# learn all existing options
590indexoptions(@files);
591
592getargs($cmd, @files);
593