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