1#!/usr/bin/env perl
2
3=begin comment
4
5This script generates the manpage.
6
7Example: gen.pl mainpage > curl.1
8
9Dev notes:
10
11We open *input* files in :crlf translation (a no-op on many platforms) in
12case we have CRLF line endings in Windows but a perl that defaults to LF.
13Unfortunately 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
19my $some_dir=$ARGV[1] || ".";
20
21opendir(my $dh, $some_dir) || die "Can't opendir $some_dir: $!";
22my @s = grep { /\.d$/ && -f "$some_dir/$_" } readdir($dh);
23closedir $dh;
24
25my %optshort;
26my %optlong;
27my %helplong;
28my %arglong;
29my %redirlong;
30my %protolong;
31
32# get the long name version, return the man page string
33sub 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
47sub 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
61sub 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
72sub overrides {
73    my ($standalone, $data)=@_;
74    if($standalone) {
75        return ".SH \"OVERRIDES\"\n$data\n";
76    }
77    else {
78        return $data;
79    }
80}
81
82sub protocols {
83    my ($standalone, $data)=@_;
84    if($standalone) {
85        return ".SH \"PROTOCOLS\"\n$data\n";
86    }
87    else {
88        return "($data) ";
89    }
90}
91
92sub 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
102sub 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 @desc;
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            if(!$helplong{$k}) {
206                print STDERR "WARN: $f see-alsos a non-existing option: $k\n";
207            }
208            my $l = manpageify($k);
209            $mstr .= sprintf "%s$l", $mstr?" and ":"";
210        }
211        push @foot, seealso($standalone, $mstr);
212    }
213    if($requires) {
214        my $l = manpageify($long);
215        push @foot, "$l requires that the underlying libcurl".
216            " was built to support $requires. ";
217    }
218    if($mutexed) {
219        my @m=split(/ /, $mutexed);
220        my $mstr;
221        for my $k (@m) {
222            if(!$helplong{$k}) {
223                print STDERR "WARN: $f mutexes a non-existing option: $k\n";
224            }
225            my $l = manpageify($k);
226            $mstr .= sprintf "%s$l", $mstr?" and ":"";
227        }
228        push @foot, overrides($standalone, "This option overrides $mstr. ");
229    }
230    if($added) {
231        push @foot, added($standalone, $added);
232    }
233    if($foot[0]) {
234        print "\n";
235        my $f = join("", @foot);
236        $f =~ s/ +\z//; # remove trailing space
237        print "$f\n";
238    }
239    return 0;
240}
241
242sub getshortlong {
243    my ($f)=@_;
244    open(F, "<:crlf", "$some_dir/$f");
245    my $short;
246    my $long;
247    my $help;
248    my $arg;
249    my $protocols;
250    while(<F>) {
251        if(/^Short: (.)/i) {
252            $short=$1;
253        }
254        elsif(/^Long: (.*)/i) {
255            $long=$1;
256        }
257        elsif(/^Help: (.*)/i) {
258            $help=$1;
259        }
260        elsif(/^Arg: (.*)/i) {
261            $arg=$1;
262        }
263        elsif(/^Protocols: (.*)/i) {
264            $protocols=$1;
265        }
266        elsif(/^---/) {
267            last;
268        }
269    }
270    close(F);
271    if($short) {
272        $optshort{$short}=$long;
273    }
274    if($long) {
275        $optlong{$long}=$short;
276        $helplong{$long}=$help;
277        $arglong{$long}=$arg;
278        $protolong{$long}=$protocols;
279    }
280}
281
282sub indexoptions {
283  foreach my $f (@s) {
284    getshortlong($f);
285  }
286}
287
288sub header {
289    my ($f)=@_;
290    open(F, "<:crlf", "$some_dir/$f");
291    my @d;
292    while(<F>) {
293        push @d, $_;
294    }
295    close(F);
296    printdesc(@d);
297}
298
299sub listhelp {
300    foreach my $f (sort keys %helplong) {
301        my $long = $f;
302        my $short = $optlong{$long};
303        my $opt;
304
305        if(defined($short) && $long) {
306            $opt = "-$short, --$long";
307        }
308        elsif($long && !$short) {
309            $opt = "    --$long";
310        }
311
312        my $arg = $arglong{$long};
313        if($arg) {
314            $opt .= " $arg";
315        }
316        my $desc = $helplong{$f};
317        $desc =~ s/\"/\\\"/g; # escape double quotes
318
319        my $line = sprintf "  {\"%s\",\n   \"%s\"},\n", $opt, $desc;
320
321        if(length($opt) + length($desc) > 78) {
322            print STDERR "WARN: the --$long line is too long\n";
323        }
324        print $line;
325    }
326}
327
328sub mainpage {
329    # show the page header
330    header("page-header");
331
332    # output docs for all options
333    foreach my $f (sort @s) {
334        single($f, 0);
335    }
336
337    header("page-footer");
338}
339
340sub showonly {
341    my ($f) = @_;
342    if(single($f, 1)) {
343        print STDERR "$f: failed\n";
344    }
345}
346
347sub showprotocols {
348    my %prots;
349    foreach my $f (keys %optlong) {
350        my @p = split(/ /, $protolong{$f});
351        for my $p (@p) {
352            $prots{$p}++;
353        }
354    }
355    for(sort keys %prots) {
356        printf "$_ (%d options)\n", $prots{$_};
357    }
358}
359
360sub getargs {
361    my $f;
362    do {
363        $f = shift @ARGV;
364        if($f eq "mainpage") {
365            mainpage();
366            return;
367        }
368        elsif($f eq "listhelp") {
369            listhelp();
370            return;
371        }
372        elsif($f eq "single") {
373            showonly(shift @ARGV);
374            return;
375        }
376        elsif($f eq "protos") {
377            showprotocols();
378            return;
379        }
380    } while($f);
381
382    print "Usage: gen.pl <mainpage/listhelp/single FILE/protos> [srcdir]\n";
383}
384
385#------------------------------------------------------------------------
386
387# learn all existing options
388indexoptions();
389
390getargs();
391