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>