• 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
48# get the long name version, return the man page string
49sub manpageify {
50    my ($k)=@_;
51    my $l;
52    if($optlong{$k} ne "") {
53        # both short + long
54        $l = "\\fI-".$optlong{$k}.", --$k\\fP";
55    }
56    else {
57        # only long
58        $l = "\\fI--$k\\fP";
59    }
60    return $l;
61}
62
63sub printdesc {
64    my @desc = @_;
65    for my $d (@desc) {
66        if($d !~ /^.\\"/) {
67            # **bold**
68            $d =~ s/\*\*([^ ]*)\*\*/\\fB$1\\fP/g;
69            # *italics*
70            $d =~ s/\*([^ ]*)\*/\\fI$1\\fP/g;
71        }
72        # skip lines starting with space (examples)
73        if($d =~ /^[^ ]/) {
74            for my $k (keys %optlong) {
75                my $l = manpageify($k);
76                $d =~ s/--$k([^a-z0-9_-])/$l$1/;
77            }
78        }
79        # quote "bare" minuses in the output
80        $d =~ s/( |\\fI|^)--/$1\\-\\-/g;
81        $d =~ s/([ -]|\\fI|^)-/$1\\-/g;
82        print $d;
83    }
84}
85
86sub seealso {
87    my($standalone, $data)=@_;
88    if($standalone) {
89        return sprintf
90            ".SH \"SEE ALSO\"\n$data\n";
91    }
92    else {
93        return "See also $data. ";
94    }
95}
96
97sub overrides {
98    my ($standalone, $data)=@_;
99    if($standalone) {
100        return ".SH \"OVERRIDES\"\n$data\n";
101    }
102    else {
103        return $data;
104    }
105}
106
107sub protocols {
108    my ($standalone, $data)=@_;
109    if($standalone) {
110        return ".SH \"PROTOCOLS\"\n$data\n";
111    }
112    else {
113        return "($data) ";
114    }
115}
116
117sub added {
118    my ($standalone, $data)=@_;
119    if($standalone) {
120        return ".SH \"ADDED\"\nAdded in curl version $data\n";
121    }
122    else {
123        return "Added in $data. ";
124    }
125}
126
127sub single {
128    my ($f, $standalone)=@_;
129    open(F, "<:crlf", "$f") ||
130        return 1;
131    my $short;
132    my $long;
133    my $tags;
134    my $added;
135    my $protocols;
136    my $arg;
137    my $mutexed;
138    my $requires;
139    my $category;
140    my $seealso;
141    my $magic; # cmdline special option
142    while(<F>) {
143        if(/^Short: *(.)/i) {
144            $short=$1;
145        }
146        elsif(/^Long: *(.*)/i) {
147            $long=$1;
148        }
149        elsif(/^Added: *(.*)/i) {
150            $added=$1;
151        }
152        elsif(/^Tags: *(.*)/i) {
153            $tags=$1;
154        }
155        elsif(/^Arg: *(.*)/i) {
156            $arg=$1;
157        }
158        elsif(/^Magic: *(.*)/i) {
159            $magic=$1;
160        }
161        elsif(/^Mutexed: *(.*)/i) {
162            $mutexed=$1;
163        }
164        elsif(/^Protocols: *(.*)/i) {
165            $protocols=$1;
166        }
167        elsif(/^See-also: *(.*)/i) {
168            $seealso=$1;
169        }
170        elsif(/^Requires: *(.*)/i) {
171            $requires=$1;
172        }
173        elsif(/^Category: *(.*)/i) {
174            $category=$1;
175        }
176        elsif(/^Help: *(.*)/i) {
177            ;
178        }
179        elsif(/^---/) {
180            if(!$long) {
181                print STDERR "ERROR: no 'Long:' in $f\n";
182                exit 1;
183            }
184            if(!$category) {
185                print STDERR "ERROR: no 'Category:' in $f\n";
186                exit 2;
187            }
188            last;
189        }
190        else {
191            chomp;
192            print STDERR "WARN: unrecognized line in $f, ignoring:\n:'$_';"
193        }
194    }
195    my @desc;
196    while(<F>) {
197        push @desc, $_;
198    }
199    close(F);
200    my $opt;
201    if(defined($short) && $long) {
202        $opt = "-$short, --$long";
203    }
204    elsif($short && !$long) {
205        $opt = "-$short";
206    }
207    elsif($long && !$short) {
208        $opt = "--$long";
209    }
210
211    if($arg) {
212        $opt .= " $arg";
213    }
214
215    # quote "bare" minuses in opt
216    $opt =~ s/( |^)--/$1\\-\\-/g;
217    $opt =~ s/( |^)-/$1\\-/g;
218    if($standalone) {
219        print ".TH curl 1 \"30 Nov 2016\" \"curl 7.52.0\" \"curl manual\"\n";
220        print ".SH OPTION\n";
221        print "curl $opt\n";
222    }
223    else {
224        print ".IP \"$opt\"\n";
225    }
226    if($protocols) {
227        print protocols($standalone, $protocols);
228    }
229
230    if($standalone) {
231        print ".SH DESCRIPTION\n";
232    }
233
234    printdesc(@desc);
235    undef @desc;
236
237    my @foot;
238    if($seealso) {
239        my @m=split(/ /, $seealso);
240        my $mstr;
241        my $and = 0;
242        my $num = scalar(@m);
243        if($num > 2) {
244            # use commas up to this point
245            $and = $num - 1;
246        }
247        my $i = 0;
248        for my $k (@m) {
249            if(!$helplong{$k}) {
250                print STDERR "WARN: $f see-alsos a non-existing option: $k\n";
251            }
252            my $l = manpageify($k);
253            my $sep = " and";
254            if($and && ($i < $and)) {
255                $sep = ",";
256            }
257            $mstr .= sprintf "%s$l", $mstr?"$sep ":"";
258            $i++;
259        }
260        push @foot, seealso($standalone, $mstr);
261    }
262    if($requires) {
263        my $l = manpageify($long);
264        push @foot, "$l requires that the underlying libcurl".
265            " was built to support $requires. ";
266    }
267    if($mutexed) {
268        my @m=split(/ /, $mutexed);
269        my $mstr;
270        for my $k (@m) {
271            if(!$helplong{$k}) {
272                print STDERR "WARN: $f mutexes a non-existing option: $k\n";
273            }
274            my $l = manpageify($k);
275            $mstr .= sprintf "%s$l", $mstr?" and ":"";
276        }
277        push @foot, overrides($standalone, "This option overrides $mstr. ");
278    }
279    if($added) {
280        push @foot, added($standalone, $added);
281    }
282    if($foot[0]) {
283        print "\n";
284        my $f = join("", @foot);
285        $f =~ s/ +\z//; # remove trailing space
286        print "$f\n";
287    }
288    return 0;
289}
290
291sub getshortlong {
292    my ($f)=@_;
293    open(F, "<:crlf", "$f");
294    my $short;
295    my $long;
296    my $help;
297    my $arg;
298    my $protocols;
299    my $category;
300    while(<F>) {
301        if(/^Short: (.)/i) {
302            $short=$1;
303        }
304        elsif(/^Long: (.*)/i) {
305            $long=$1;
306        }
307        elsif(/^Help: (.*)/i) {
308            $help=$1;
309        }
310        elsif(/^Arg: (.*)/i) {
311            $arg=$1;
312        }
313        elsif(/^Protocols: (.*)/i) {
314            $protocols=$1;
315        }
316        elsif(/^Category: (.*)/i) {
317            $category=$1;
318        }
319        elsif(/^---/) {
320            last;
321        }
322    }
323    close(F);
324    if($short) {
325        $optshort{$short}=$long;
326    }
327    if($long) {
328        $optlong{$long}=$short;
329        $helplong{$long}=$help;
330        $arglong{$long}=$arg;
331        $protolong{$long}=$protocols;
332        $catlong{$long}=$category;
333    }
334}
335
336sub indexoptions {
337    my (@files) = @_;
338    foreach my $f (@files) {
339        getshortlong($f);
340    }
341}
342
343sub header {
344    my ($f)=@_;
345    open(F, "<:crlf", "$f");
346    my @d;
347    while(<F>) {
348        push @d, $_;
349    }
350    close(F);
351    printdesc(@d);
352}
353
354sub listhelp {
355    foreach my $f (sort keys %helplong) {
356        my $long = $f;
357        my $short = $optlong{$long};
358        my @categories = split ' ', $catlong{$long};
359        my $bitmask;
360        my $opt;
361
362        if(defined($short) && $long) {
363            $opt = "-$short, --$long";
364        }
365        elsif($long && !$short) {
366            $opt = "    --$long";
367        }
368        for my $i (0 .. $#categories) {
369            $bitmask .= 'CURLHELP_' . uc $categories[$i];
370            # If not last element, append |
371            if($i < $#categories) {
372                $bitmask .= ' | ';
373            }
374        }
375        my $arg = $arglong{$long};
376        if($arg) {
377            $opt .= " $arg";
378        }
379        my $desc = $helplong{$f};
380        $desc =~ s/\"/\\\"/g; # escape double quotes
381
382        my $line = sprintf "  {\"%s\",\n   \"%s\",\n   %s},\n", $opt, $desc, $bitmask;
383
384        if(length($opt) > 78) {
385            print STDERR "WARN: the --$long name is too long\n";
386        }
387        elsif(length($desc) > 78) {
388            print STDERR "WARN: the --$long description is too long\n";
389        }
390        print $line;
391    }
392}
393
394sub listcats {
395    my %allcats;
396    foreach my $f (sort keys %helplong) {
397        my @categories = split ' ', $catlong{$f};
398        foreach (@categories) {
399            $allcats{$_} = undef;
400        }
401    }
402    my @categories;
403    foreach my $key (keys %allcats) {
404        push @categories, $key;
405    }
406    @categories = sort @categories;
407    unshift @categories, 'hidden';
408    for my $i (0..$#categories) {
409        print '#define ' . 'CURLHELP_' . uc($categories[$i]) . ' ' . "1u << " . $i . "u\n";
410    }
411}
412
413sub mainpage {
414    my (@files) = @_;
415    # show the page header
416    header("page-header");
417
418    # output docs for all options
419    foreach my $f (sort @files) {
420        if(single($f, 0)) {
421            print STDERR "Can't read $f?\n";
422        }
423    }
424
425    header("page-footer");
426}
427
428sub showonly {
429    my ($f) = @_;
430    if(single($f, 1)) {
431        print STDERR "$f: failed\n";
432    }
433}
434
435sub showprotocols {
436    my %prots;
437    foreach my $f (keys %optlong) {
438        my @p = split(/ /, $protolong{$f});
439        for my $p (@p) {
440            $prots{$p}++;
441        }
442    }
443    for(sort keys %prots) {
444        printf "$_ (%d options)\n", $prots{$_};
445    }
446}
447
448sub getargs {
449    my ($f, @s) = @_;
450    if($f eq "mainpage") {
451        mainpage(@s);
452        return;
453    }
454    elsif($f eq "listhelp") {
455        listhelp();
456        return;
457    }
458    elsif($f eq "single") {
459        showonly($s[0]);
460        return;
461    }
462    elsif($f eq "protos") {
463        showprotocols();
464        return;
465    }
466    elsif($f eq "listcats") {
467        listcats();
468        return;
469    }
470
471    print "Usage: gen.pl <mainpage/listhelp/single FILE/protos/listcats> [files]\n";
472}
473
474#------------------------------------------------------------------------
475
476my $cmd = shift @ARGV;
477my @files = @ARGV; # the rest are the files
478
479# learn all existing options
480indexoptions(@files);
481
482getargs($cmd, @files);
483