xref: /curl/scripts/managen (revision 28d3c5dc) 
1#!/usr/bin/env perl
2#***************************************************************************
3#                                  _   _ ____  _
4#  Project                     ___| | | |  _ \| |
5#                             / __| | | | |_) | |
6#                            | (__| |_| |  _ <| |___
7#                             \___|\___/|_| \_\_____|
8#
9# Copyright (C) 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# SPDX-License-Identifier: curl
23#
24###########################################################################
25
26=begin comment
27
28This script generates the manpage.
29
30Example: managen <command> [files] > curl.1
31
32Dev notes:
33
34We open *input* files in :crlf translation (a no-op on many platforms) in
35case we have CRLF line endings in Windows but a perl that defaults to LF.
36Unfortunately it seems some perls like msysgit cannot handle a global input-only
37:crlf so it has to be specified on each file open for text input.
38
39=end comment
40=cut
41
42my %optshort;
43my %optlong;
44my %helplong;
45my %arglong;
46my %redirlong;
47my %protolong;
48my %catlong;
49
50use POSIX qw(strftime);
51my @ts;
52if (defined($ENV{SOURCE_DATE_EPOCH})) {
53    @ts = gmtime($ENV{SOURCE_DATE_EPOCH});
54} else {
55    @ts = localtime;
56}
57my $date = strftime "%Y-%m-%d", @ts;
58my $year = strftime "%Y", @ts;
59my $version = "unknown";
60my $globals;
61my $error = 0;
62my $indent = 4;
63
64# get the long name version, return the manpage string
65sub manpageify {
66    my ($k)=@_;
67    my $l;
68    my $trail;
69    # the matching pattern might include a trailing dot that cannot be part of
70    # the option name
71    if($k =~ s/\.$//) {
72        # cut off trailing dot
73        $trail = ".";
74    }
75    my $klong = $k;
76    # quote "bare" minuses in the long name
77    $klong =~ s/-/\\-/g;
78    if($optlong{$k}) {
79        # both short + long
80        $l = "\\fI-".$optlong{$k}.", \\-\\-$klong\\fP$trail";
81    }
82    else {
83        # only long
84        $l = "\\fI\\-\\-$klong\\fP$trail";
85    }
86    return $l;
87}
88
89
90my $colwidth=79; # max number of columns
91
92sub prefixline {
93    my ($num) = @_;
94    print "\t" x ($num/8);
95    print ' ' x ($num%8);
96}
97
98sub justline {
99    my ($lvl, @line) = @_;
100    my $w = -1;
101    my $spaces = -1;
102    my $width = $colwidth - ($lvl * $indent);
103    for(@line) {
104        $w += length($_);
105        $w++;
106        $spaces++;
107    }
108    my $inject = $width - $w;
109    my $ratio = 0; # stay at zero if no spaces at all
110    if($spaces) {
111        $ratio = $inject / $spaces;
112    }
113    my $spare = 0;
114    prefixline($lvl * $indent);
115    my $prev;
116    for(@line) {
117        while($spare >= 0.90) {
118            print " ";
119            $spare--;
120        }
121        printf "%s%s", $prev?" ":"", $_;
122        $prev = 1;
123        $spare += $ratio;
124    }
125    print "\n";
126}
127
128sub lastline {
129    my ($lvl, @line) = @_;
130    $line[0] =~ s/^( +)//;
131    prefixline($lvl * $indent + length($1));
132    my $prev = 0;
133    for(@line) {
134        printf "%s%s", $prev?" ":"", $_;
135        $prev = 1;
136    }
137    print "\n";
138}
139
140sub outputpara {
141    my ($lvl, $f) = @_;
142    $f =~ s/\n/ /g;
143
144    my $w = 0;
145    my @words = split(/  */, $f);
146    my $width = $colwidth - ($lvl * $indent);
147
148    my @line;
149    for my $e (@words) {
150        my $l = length($e);
151        my $spaces = scalar(@line);
152        if(($w + $l + $spaces) >= $width) {
153            justline($lvl, @line);
154            undef @line;
155            $w = 0;
156        }
157
158        push @line, $e;
159        $w += $l; # new width
160    }
161    if($w) {
162        lastline($lvl, @line);
163        print "\n";
164    }
165}
166
167sub printdesc {
168    my ($manpage, $baselvl, @desc) = @_;
169
170    if($manpage) {
171        for my $d (@desc) {
172            print $d;
173        }
174    }
175    else {
176        my $p = -1;
177        my $para;
178        for my $l (@desc) {
179            my $lvl;
180            if($l !~ /^[\n\r]+/) {
181                # get the indent level off the string
182                $l =~ s/^\[([0-9q]*)\]//;
183                $lvl = $1;
184            }
185            if(($p =~ /q/) && ($lvl !~ /q/)) {
186                # the previous was quoted, this is not
187                print "\n";
188            }
189            if($lvl != $p) {
190                outputpara($baselvl + $p, $para);
191                $para = "";
192            }
193            if($lvl =~ /q/) {
194                # quoted, do not right-justify
195                chomp $l;
196                lastline($baselvl + $lvl + 1, $l);
197                my $w = ($baselvl + $lvl + 1) * $indent + length($l);
198                if ($w > $colwidth) {
199                    print STDERR "ERROR: $w columns is too long\n";
200                    print STDERR "$l\n";
201                    $error++;
202                }
203            }
204            else {
205                $para .= $l;
206            }
207
208            $p = $lvl;
209        }
210        outputpara($baselvl + $p, $para);
211    }
212}
213
214sub seealso {
215    my($standalone, $data)=@_;
216    if($standalone) {
217        return sprintf
218            ".SH \"SEE ALSO\"\n$data\n";
219    }
220    else {
221        return "See also $data. ";
222    }
223}
224
225sub overrides {
226    my ($standalone, $data)=@_;
227    if($standalone) {
228        return ".SH \"OVERRIDES\"\n$data\n";
229    }
230    else {
231        return $data;
232    }
233}
234
235sub protocols {
236    my ($manpage, $standalone, $data)=@_;
237    if($standalone) {
238        return ".SH \"PROTOCOLS\"\n$data\n";
239    }
240    else {
241        return "($data) " if($manpage);
242        return "[1]($data) " if(!$manpage);
243    }
244}
245
246sub too_old {
247    my ($version)=@_;
248    my $a = 999999;
249    if($version =~ /^(\d+)\.(\d+)\.(\d+)/) {
250        $a = $1 * 1000 + $2 * 10 + $3;
251    }
252    elsif($version =~ /^(\d+)\.(\d+)/) {
253        $a = $1 * 1000 + $2 * 10;
254    }
255    if($a < 7600) {
256        # we consider everything before 7.60.0 to be too old to mention
257        # specific changes for
258        return 1;
259    }
260    return 0;
261}
262
263sub added {
264    my ($standalone, $data)=@_;
265    if(too_old($data)) {
266        # do not mention ancient additions
267        return "";
268    }
269    if($standalone) {
270        return ".SH \"ADDED\"\nAdded in curl version $data\n";
271    }
272    else {
273        return "Added in $data. ";
274    }
275}
276
277sub render {
278    my ($manpage, $fh, $f, $line) = @_;
279    my @desc;
280    my $tablemode = 0;
281    my $header = 0;
282    # if $top is TRUE, it means a top-level page and not a command line option
283    my $top = ($line == 1);
284    my $quote;
285    my $level;
286    my $finalblank;
287    $start = 0;
288
289    while(<$fh>) {
290        my $d = $_;
291        $line++;
292        $finalblank = ($d eq "\n");
293        if($d =~ /^\.(SH|BR|IP|B)/) {
294            print STDERR "$f:$line:1:ERROR: nroff instruction in input: \".$1\"\n";
295            return 4;
296        }
297        if(/^ *<!--/) {
298            # skip comments
299            next;
300        }
301        if((!$start) && ($_ =~ /^[\r\n]*\z/)) {
302            # skip leading blank lines
303            next;
304        }
305
306        $start = 1;
307
308        if(/^[ \t]*\n/) {
309            # count and ignore blank lines
310            $blankline++;
311            next;
312        }
313        elsif($d =~ /^    (.*)/) {
314            my $word = $1;
315            if(!$quote && $manpage) {
316                push @desc, "\n" if($blankline);
317                push @desc, ".nf\n";
318                $blankline = 0;
319            }
320            $quote = 1;
321            $d = "$word\n";
322        }
323        elsif($quote) {
324            # end of quote
325            push @desc, ".fi\n" if($manpage);
326            $quote = 0;
327        }
328
329        if(/^# (.*)/) {
330            $header = 1;
331            if($top != 1) {
332                # ignored for command line options
333                $blankline++;
334                next;
335            }
336            push @desc, ".SH $1\n" if($manpage);
337            push @desc, "[0]$1\n" if(!$manpage);
338            next;
339        }
340        elsif(/^###/) {
341            print STDERR "$f:$line:1:ERROR: ### header is not supported\n";
342            exit 3;
343        }
344        elsif(/^## (.*)/) {
345            my $word = $1;
346            # if there are enclosing quotes, remove them first
347            $word =~ s/[\"\'](.*)[\"\']\z/$1/;
348
349            # remove backticks from headers
350            $word =~ s/\`//g;
351
352            # if there is a space, it needs quotes for manpage
353            if(($word =~ / /) && $manpage) {
354                $word = "\"$word\"";
355            }
356            $level = 1;
357            if($top == 1) {
358                push @desc, ".IP $word\n" if($manpage);
359                push @desc, "\n" if(!$manpage);
360                push @desc, "[1]$word\n" if(!$manpage);
361            }
362            else {
363                if(!$tablemode) {
364                    push @desc, ".RS\n" if($manpage);
365                    $tablemode = 1;
366                }
367                push @desc, ".IP $word\n" if($manpage);
368                push @desc, "\n" if(!$manpage);
369                push @desc, "[1]$word\n" if(!$manpage);
370            }
371            $header = 1;
372            next;
373        }
374        elsif(/^##/) {
375            if($top == 1) {
376                print STDERR "$f:$line:1:ERROR: ## empty header top-level mode\n";
377                exit 3;
378            }
379            if($tablemode) {
380                # end of table
381                push @desc, ".RE\n.IP\n" if($manpage);
382                $tablemode = 0;
383            }
384            $header = 1;
385            next;
386        }
387        elsif(/^\.(IP|RS|RE)/) {
388            my ($cmd) = ($1);
389            print STDERR "$f:$line:1:ERROR: $cmd detected, use ##-style\n";
390            return 3;
391        }
392
393        $d =~ s/`%DATE`/$date/g;
394        $d =~ s/`%VERSION`/$version/g;
395        $d =~ s/`%GLOBALS`/$globals/g;
396
397        if(!$quote) {
398            if($d =~ /^(.*)  /) {
399                printf STDERR "$f:$line:%d:ERROR: 2 spaces detected\n",
400                    length($1);
401                return 3;
402            }
403            my $back = $d;
404
405            # remove all backticked pieces
406            $back =~ s/\`(.*?)\`//g;
407
408            if($back =~ /[^\\][\<\>]/) {
409                print STDERR "$f:$line:1:WARN: un-escaped < or > used: $back\n";
410                return 3;
411            }
412        }
413
414        # convert backticks to double quotes
415        $d =~ s/\`/\"/g;
416
417        if($d =~ /\(added in(.*)/i) {
418            if(length($1) < 2) {
419                print STDERR "$f:$line:1:ERROR: broken up added-in line:\n";
420                print STDERR "$f:$line:1:ERROR: $d";
421                return 3;
422            }
423        }
424      again:
425        if($d =~ /\(Added in ([0-9.]+)\)/i) {
426            my $ver = $1;
427            if(too_old($ver)) {
428                $d =~ s/ *\(Added in $ver\)//gi;
429                goto again;
430            }
431        }
432
433        # convert backslash-'<' or '> to just the second character
434        $d =~ s/\\([><])/$1/g;
435        # convert single backslash to double-backslash
436        $d =~ s/\\/\\\\/g if($manpage);
437
438
439        if($manpage) {
440            if(!$quote && $d =~ /--/) {
441                $d =~ s/--([a-z0-9.-]+)/manpageify($1)/ge;
442            }
443
444            # quote minuses in the output
445            $d =~ s/([^\\])-/$1\\-/g;
446            # replace single quotes
447            $d =~ s/\'/\\(aq/g;
448            # handle double quotes or periods first on the line
449            $d =~ s/^([\.\"])/\\&$1/;
450            # **bold**
451            $d =~ s/\*\*(\S.*?)\*\*/\\fB$1\\fP/g;
452            # *italics*
453            $d =~ s/\*(\S.*?)\*/\\fI$1\\fP/g;
454        }
455        else {
456            # **bold**
457            $d =~ s/\*\*(\S.*?)\*\*/$1/g;
458            # *italics*
459            $d =~ s/\*(\S.*?)\*/$1/g;
460        }
461        # trim trailing spaces
462        $d =~ s/[ \t]+\z//;
463        push @desc, "\n" if($blankline && !$header);
464        $blankline = 0;
465        push @desc, $d if($manpage);
466        my $qstr = $quote ? "q": "";
467        push @desc, "[".(1 + $level)."$qstr]$d" if(!$manpage);
468        $header = 0;
469
470    }
471    if($finalblank) {
472        print STDERR "$f:$line:1:ERROR: trailing blank line\n";
473        exit 3;
474    }
475    if($quote) {
476        # don't leave the quote "hanging"
477        push @desc, ".fi\n" if($manpage);
478    }
479    if($tablemode) {
480        # end of table
481        push @desc, ".RE\n.IP\n" if($manpage);
482    }
483    return @desc;
484}
485
486sub maybespace {
487    my ($string) = @_;
488
489    if(($string =~ /(.* )(.*)/) &&
490       (length($2) <= 20)) {
491        return $1;
492    }
493    if(($string =~ /(.*:)(.*)/) &&
494       (length($2) <= 20)) {
495        return $1;
496    }
497    return $string;
498}
499
500sub single {
501    my ($dir, $manpage, $f, $standalone)=@_;
502    my $fh;
503    open($fh, "<:crlf", "$dir/$f") ||
504        die "could not find $dir/$f";
505    my $short;
506    my $long;
507    my $tags;
508    my $added;
509    my $protocols;
510    my $arg;
511    my $mutexed;
512    my $requires;
513    my $category;
514    my @seealso;
515    my $copyright;
516    my $spdx;
517    my @examples; # there can be more than one
518    my $magic; # cmdline special option
519    my $line;
520    my $dline;
521    my $multi;
522    my $scope;
523    my $experimental;
524    my $start;
525    my $list; # identifies the list, 1 example, 2 see-also
526    while(<$fh>) {
527        $line++;
528        if(/^ *<!--/) {
529            next;
530        }
531        if(!$start) {
532            if(/^---/) {
533                $start = 1;
534            }
535            next;
536        }
537        if(/^Short: *(.)/i) {
538            $short=$1;
539        }
540        elsif(/^Long: *(.*)/i) {
541            $long=$1;
542        }
543        elsif(/^Added: *(.*)/i) {
544            $added=$1;
545        }
546        elsif(/^Tags: *(.*)/i) {
547            $tags=$1;
548        }
549        elsif(/^Arg: *(.*)/i) {
550            $arg=$1;
551        }
552        elsif(/^Magic: *(.*)/i) {
553            $magic=$1;
554        }
555        elsif(/^Mutexed: *(.*)/i) {
556            $mutexed=$1;
557        }
558        elsif(/^Protocols: *(.*)/i) {
559            $protocols=$1;
560        }
561        elsif(/^See-also: +(.+)/i) {
562            if($seealso) {
563                print STDERR "ERROR: duplicated See-also in $f\n";
564                return 1;
565            }
566            push @seealso, $1;
567        }
568        elsif(/^See-also:/i) {
569            $list=2;
570        }
571        elsif(/^  *- (.*)/i && ($list == 2)) {
572            push @seealso, $1;
573        }
574        elsif(/^Requires: *(.*)/i) {
575            $requires=$1;
576        }
577        elsif(/^Category: *(.*)/i) {
578            $category=$1;
579        }
580        elsif(/^Example: +(.+)/i) {
581            push @examples, $1;
582        }
583        elsif(/^Example:/i) {
584            # '1' is the example list
585            $list = 1;
586        }
587        elsif(/^  *- (.*)/i && ($list == 1)) {
588            push @examples, $1;
589        }
590        elsif(/^Multi: *(.*)/i) {
591            $multi=$1;
592        }
593        elsif(/^Scope: *(.*)/i) {
594            $scope=$1;
595        }
596        elsif(/^Experimental: yes/i) {
597            $experimental=1;
598        }
599        elsif(/^C: (.*)/i) {
600            $copyright=$1;
601        }
602        elsif(/^SPDX-License-Identifier: (.*)/i) {
603            $spdx=$1;
604        }
605        elsif(/^Help: *(.*)/i) {
606            ;
607        }
608        elsif(/^---/) {
609            $start++;
610            if(!$long) {
611                print STDERR "ERROR: no 'Long:' in $f\n";
612                return 1;
613            }
614            if(!$category) {
615                print STDERR "ERROR: no 'Category:' in $f\n";
616                return 2;
617            }
618            if(!$examples[0]) {
619                print STDERR "$f:$line:1:ERROR: no 'Example:' present\n";
620                return 2;
621            }
622            if(!$added) {
623                print STDERR "$f:$line:1:ERROR: no 'Added:' version present\n";
624                return 2;
625            }
626            if(!$seealso[0]) {
627                print STDERR "$f:$line:1:ERROR: no 'See-also:' field present\n";
628                return 2;
629            }
630            if(!$copyright) {
631                print STDERR "$f:$line:1:ERROR: no 'C:' field present\n";
632                return 2;
633            }
634            if(!$spdx) {
635                print STDERR "$f:$line:1:ERROR: no 'SPDX-License-Identifier:' field present\n";
636                return 2;
637            }
638            last;
639        }
640        else {
641            chomp;
642            print STDERR "$f:$line:1:WARN: unrecognized line in $f, ignoring:\n:'$_';"
643        }
644    }
645
646    if($start < 2) {
647        print STDERR "$f:1:1:ERROR: no proper meta-data header\n";
648        return 2;
649    }
650
651    my @desc = render($manpage, $fh, $f, $line);
652    close($fh);
653    if($tablemode) {
654        # end of table
655        push @desc, ".RE\n.IP\n";
656    }
657    my $opt;
658
659    if(defined($short) && $long) {
660        $opt = "-$short, --$long";
661    }
662    elsif($short && !$long) {
663        $opt = "-$short";
664    }
665    elsif($long && !$short) {
666        $opt = "--$long";
667    }
668
669    if($arg) {
670        $opt .= " $arg";
671    }
672
673    # quote "bare" minuses in opt
674    $opt =~ s/-/\\-/g if($manpage);
675    if($standalone) {
676        print ".TH curl 1 \"30 Nov 2016\" \"curl 7.52.0\" \"curl manual\"\n";
677        print ".SH OPTION\n";
678        print "curl $opt\n";
679    }
680    elsif($manpage) {
681        print ".IP \"$opt\"\n";
682    }
683    else {
684        lastline(1, $opt);
685    }
686    my @leading;
687    if($protocols) {
688        push @leading, protocols($manpage, $standalone, $protocols);
689    }
690
691    if($standalone) {
692        print ".SH DESCRIPTION\n";
693    }
694
695    if($experimental) {
696        push @leading, "**WARNING**: this option is experimental. Do not use in production.\n\n";
697    }
698
699    my $pre = $manpage ? "\n": "[1]";
700
701    if($scope) {
702        if($category !~ /global/) {
703            print STDERR "$f:$line:1:ERROR: global scope option does not have global category\n";
704            return 2;
705        }
706        if($scope eq "global") {
707            push @desc, "\n" if(!$manpage);
708            push @desc, "${pre}This option is global and does not need to be specified for each use of --next.\n";
709        }
710        else {
711            print STDERR "$f:$line:1:ERROR: unrecognized scope: '$scope'\n";
712            return 2;
713        }
714    }
715
716    my @extra;
717    if($multi eq "single") {
718        push @extra, "${pre}If --$long is provided several times, the last set ".
719            "value is used.\n";
720    }
721    elsif($multi eq "append") {
722        push @extra, "${pre}--$long can be used several times in a command line\n";
723    }
724    elsif($multi eq "boolean") {
725        my $rev = "no-$long";
726        # for options that start with "no-" the reverse is then without
727        # the no- prefix
728        if($long =~ /^no-/) {
729            $rev = $long;
730            $rev =~ s/^no-//;
731        }
732        my $dashes = $manpage ? "\\-\\-" : "--";
733        push @extra,
734            "${pre}Providing --$long multiple times has no extra effect.\n".
735            "Disable it again with $dashes$rev.\n";
736    }
737    elsif($multi eq "mutex") {
738        push @extra,
739            "${pre}Providing --$long multiple times has no extra effect.\n";
740    }
741    elsif($multi eq "custom") {
742        ; # left for the text to describe
743    }
744    elsif($multi eq "per-URL") {
745        push @extra,
746            "${pre}--$long is associated with a single URL. Use it once per URL ".
747            "when you use several URLs in a command line.\n";
748    }
749    else {
750        print STDERR "$f:$line:1:ERROR: unrecognized Multi: '$multi'\n";
751        return 2;
752    }
753
754    printdesc($manpage, 2, (@leading, @desc, @extra));
755    undef @desc;
756
757    my @foot;
758
759    my $mstr;
760    my $and = 0;
761    my $num = scalar(@seealso);
762    if($num > 2) {
763        # use commas up to this point
764        $and = $num - 1;
765    }
766    my $i = 0;
767    for my $k (@seealso) {
768        if(!$helplong{$k}) {
769            print STDERR "$f:$line:1:WARN: see-also a non-existing option: $k\n";
770        }
771        my $l = $manpage ? manpageify($k) : "--$k";
772        my $sep = " and";
773        if($and && ($i < $and)) {
774            $sep = ",";
775        }
776        $mstr .= sprintf "%s$l", $mstr?"$sep ":"";
777        $i++;
778    }
779
780    if($requires) {
781        my $l = $manpage ? manpageify($long) : "--$long";
782        push @foot, "$l requires that libcurl".
783            " is built to support $requires.\n";
784    }
785    if($mutexed) {
786        my @m=split(/ /, $mutexed);
787        my $mstr;
788        my $num = scalar(@m);
789        my $count;
790        for my $k (@m) {
791            if(!$helplong{$k}) {
792                print STDERR "WARN: $f mutexes a non-existing option: $k\n";
793            }
794            my $l = $manpage ? manpageify($k) : "--$k";
795            my $sep = ", ";
796            if($count == ($num -1)) {
797                $sep = " and ";
798            }
799            $mstr .= sprintf "%s$l", $mstr?$sep:"";
800            $count++;
801        }
802        push @foot, overrides($standalone,
803                              "This option is mutually exclusive with $mstr.\n");
804    }
805    if($examples[0]) {
806        my $s ="";
807        $s="s" if($examples[1]);
808        if($manpage) {
809            print "\nExample$s:\n";
810            print ".nf\n";
811            foreach my $e (@examples) {
812                $e =~ s!\$URL!https://example.com!g;
813                # convert single backslahes to doubles
814                $e =~ s/\\/\\\\/g;
815                print "curl $e\n";
816            }
817            print ".fi\n";
818        }
819        else {
820            my @ex;
821            push @ex, "[0q]Example$s:\n";
822            #
823            # long ASCII examples are wrapped. Preferably at the last space
824            # before the margin. Or at a colon. Otherwise it just cuts at the
825            # exact boundary.
826            #
827            foreach my $e (@examples) {
828                $e =~ s!\$URL!https://example.com!g;
829                my $maxwidth = 60; # plus the "    curl " 18 col prefix
830                if(length($e) > $maxwidth) {
831                    # a long example, shorten it
832                    my $p = substr($e, 0, $maxwidth);
833                    $p = maybespace($p);
834                    push @ex, "[0q] curl ".$p."\\";
835                    $e = substr($e, length($p));
836                    do {
837                        my $r = substr($e, 0, $maxwidth);
838                        if(length($e) > $maxwidth) {
839                            $r = maybespace($r);
840                        }
841                        my $slash ="";
842                        $e = substr($e, length($r));
843                        if(length($e) > 0) {
844                            $slash = "\\";
845                        }
846
847                        push @ex, "[0q]      $r$slash" if($r);
848                    } while(length($e));
849                }
850                else {
851                    push @ex, "[0q] curl $e\n";
852                }
853            }
854            printdesc($manpage, 2, @ex);
855        }
856    }
857    if($added) {
858        push @foot, added($standalone, $added);
859    }
860    push @foot, seealso($standalone, $mstr);
861
862    print "\n";
863    my $f = join("", @foot);
864    if($manpage) {
865        $f =~ s/ +\z//; # remove trailing space
866        print "$f\n";
867    }
868    else {
869        printdesc($manpage, 2, "[1]$f");
870    }
871    return 0;
872}
873
874sub getshortlong {
875    my ($dir, $f)=@_;
876    $f =~ s/^.*\///;
877    open(F, "<:crlf", "$dir/$f") ||
878        die "could not find $dir/$f";
879    my $short;
880    my $long;
881    my $help;
882    my $arg;
883    my $protocols;
884    my $category;
885    my $start = 0;
886    my $line = 0;
887    while(<F>) {
888        $line++;
889        if(!$start) {
890            if(/^---/) {
891                $start = 1;
892            }
893            next;
894        }
895        if(/^Short: (.)/i) {
896            $short=$1;
897        }
898        elsif(/^Long: (.*)/i) {
899            $long=$1;
900        }
901        elsif(/^Help: (.*)/i) {
902            $help=$1;
903            my $len = length($help);
904            if($len >= 49) {
905                printf STDERR "$f:$line:1:WARN: oversized help text: %d characters\n",
906                    $len;
907            }
908        }
909        elsif(/^Arg: (.*)/i) {
910            $arg=$1;
911        }
912        elsif(/^Protocols: (.*)/i) {
913            $protocols=$1;
914        }
915        elsif(/^Category: (.*)/i) {
916            $category=$1;
917        }
918        elsif(/^---/) {
919            last;
920        }
921    }
922    close(F);
923    if($short) {
924        $optshort{$short}=$long;
925    }
926    if($long) {
927        $optlong{$long}=$short;
928        $helplong{$long}=$help;
929        $arglong{$long}=$arg;
930        $protolong{$long}=$protocols;
931        $catlong{$long}=$category;
932    }
933}
934
935sub indexoptions {
936    my ($dir, @files) = @_;
937    foreach my $f (@files) {
938        getshortlong($dir, $f);
939    }
940}
941
942sub header {
943    my ($dir, $manpage, $f)=@_;
944    my $fh;
945    open($fh, "<:crlf", "$dir/$f") ||
946        die "could not find $dir/$f";
947    my @d = render($manpage, $fh, $f, 1);
948    close($fh);
949    printdesc($manpage, 0, @d);
950}
951
952
953sub sourcecategories {
954    my ($dir) = @_;
955    my %cats;
956    open(H, "<$dir/../../src/tool_help.h") ||
957        die "can't find the header file";
958    while(<H>) {
959        if(/^\#define CURLHELP_([A-Z0-9]*)/) {
960            $cats{lc($1)}++;
961        }
962    }
963    close(H);
964    return %cats;
965}
966
967sub listhelp {
968    my ($dir) = @_;
969    my %cats = sourcecategories($dir);
970
971    print <<HEAD
972/***************************************************************************
973 *                                  _   _ ____  _
974 *  Project                     ___| | | |  _ \\| |
975 *                             / __| | | | |_) | |
976 *                            | (__| |_| |  _ <| |___
977 *                             \\___|\\___/|_| \\_\\_____|
978 *
979 * Copyright (C) Daniel Stenberg, <daniel\@haxx.se>, et al.
980 *
981 * This software is licensed as described in the file COPYING, which
982 * you should have received as part of this distribution. The terms
983 * are also available at https://curl.se/docs/copyright.html.
984 *
985 * You may opt to use, copy, modify, merge, publish, distribute and/or sell
986 * copies of the Software, and permit persons to whom the Software is
987 * furnished to do so, under the terms of the COPYING file.
988 *
989 * This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
990 * KIND, either express or implied.
991 *
992 * SPDX-License-Identifier: curl
993 *
994 ***************************************************************************/
995#include "tool_setup.h"
996#include "tool_help.h"
997
998/*
999 * DO NOT edit tool_listhelp.c manually.
1000 * This source file is generated with the following command in an autotools
1001 * build:
1002 *
1003 * "make listhelp"
1004 */
1005
1006const struct helptxt helptext[] = {
1007HEAD
1008        ;
1009    foreach my $f (sort keys %helplong) {
1010        my $long = $f;
1011        my $short = $optlong{$long};
1012        my @categories = split ' ', $catlong{$long};
1013        my $bitmask = ' ';
1014        my $opt;
1015
1016        if(defined($short) && $long) {
1017            $opt = "-$short, --$long";
1018        }
1019        elsif($long && !$short) {
1020            $opt = "    --$long";
1021        }
1022        for my $i (0 .. $#categories) {
1023            if(!$cats{ $categories[$i] }) {
1024                printf STDERR "$f.md:ERROR: Unknown category '%s'\n",
1025                    $categories[$i];
1026                exit 3;
1027            }
1028
1029            $bitmask .= 'CURLHELP_' . uc $categories[$i];
1030            # If not last element, append |
1031            if($i < $#categories) {
1032                $bitmask .= ' | ';
1033            }
1034        }
1035        $bitmask =~ s/(?=.{76}).{1,76}\|/$&\n  /g;
1036        my $arg = $arglong{$long};
1037        if($arg) {
1038            $opt .= " $arg";
1039        }
1040        my $desc = $helplong{$f};
1041        $desc =~ s/\"/\\\"/g; # escape double quotes
1042
1043        my $line = sprintf "  {\"%s\",\n   \"%s\",\n  %s},\n", $opt, $desc, $bitmask;
1044
1045        if(length($opt) > 78) {
1046            print STDERR "WARN: the --$long name is too long\n";
1047        }
1048        elsif(length($desc) > 78) {
1049            print STDERR "WARN: the --$long description is too long\n";
1050        }
1051        print $line;
1052    }
1053    print <<FOOT
1054  { NULL, NULL, 0 }
1055};
1056FOOT
1057        ;
1058}
1059
1060sub listcats {
1061    my %allcats;
1062    foreach my $f (sort keys %helplong) {
1063        my @categories = split ' ', $catlong{$f};
1064        foreach (@categories) {
1065            $allcats{$_} = undef;
1066        }
1067    }
1068    my @categories;
1069    foreach my $key (keys %allcats) {
1070        push @categories, $key;
1071    }
1072    @categories = sort @categories;
1073    for my $i (0..$#categories) {
1074        printf("#define CURLHELP_%-10s (%s)\n",
1075               uc($categories[$i]), "1u << ${i}u");
1076    }
1077}
1078
1079sub listglobals {
1080    my ($dir, @files) = @_;
1081    my @globalopts;
1082
1083    # Find all global options and output them
1084    foreach my $f (sort @files) {
1085        open(F, "<:crlf", "$dir/$f") ||
1086            die "could not read $dir/$f";
1087        my $long;
1088        my $start = 0;
1089        while(<F>) {
1090            if(/^---/) {
1091                if(!$start) {
1092                    $start = 1;
1093                    next;
1094                }
1095                else {
1096                    last;
1097                }
1098            }
1099            if(/^Long: *(.*)/i) {
1100                $long=$1;
1101            }
1102            elsif(/^Scope: global/i) {
1103                push @globalopts, $long;
1104                last;
1105            }
1106        }
1107        close(F);
1108    }
1109    return $ret if($ret);
1110    for my $e (0 .. $#globalopts) {
1111        $globals .= sprintf "%s--%s",  $e?($globalopts[$e+1] ? ", " : " and "):"",
1112            $globalopts[$e],;
1113    }
1114}
1115
1116sub noext {
1117    my $in = $_[0];
1118    $in =~ s/\.md//;
1119    return $in;
1120}
1121
1122sub sortnames {
1123    return noext($a) cmp noext($b);
1124}
1125
1126sub mainpage {
1127    my ($dir, $manpage, @files) = @_;
1128    # $manpage is 1 for nroff, 0 for ASCII
1129    my $ret;
1130    my $fh;
1131    open($fh, "<:crlf", "$dir/mainpage.idx") ||
1132        die "no $dir/mainpage.idx file";
1133
1134    print <<HEADER
1135.\\" **************************************************************************
1136.\\" *                                  _   _ ____  _
1137.\\" *  Project                     ___| | | |  _ \\| |
1138.\\" *                             / __| | | | |_) | |
1139.\\" *                            | (__| |_| |  _ <| |___
1140.\\" *                             \\___|\\___/|_| \\_\\_____|
1141.\\" *
1142.\\" * Copyright (C) Daniel Stenberg, <daniel\@haxx.se>, et al.
1143.\\" *
1144.\\" * This software is licensed as described in the file COPYING, which
1145.\\" * you should have received as part of this distribution. The terms
1146.\\" * are also available at https://curl.se/docs/copyright.html.
1147.\\" *
1148.\\" * You may opt to use, copy, modify, merge, publish, distribute and/or sell
1149.\\" * copies of the Software, and permit persons to whom the Software is
1150.\\" * furnished to do so, under the terms of the COPYING file.
1151.\\" *
1152.\\" * This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
1153.\\" * KIND, either express or implied.
1154.\\" *
1155.\\" * SPDX-License-Identifier: curl
1156.\\" *
1157.\\" **************************************************************************
1158.\\"
1159.\\" DO NOT EDIT. Generated by the curl project managen manpage generator.
1160.\\"
1161.TH curl 1 "$date" "curl $version" "curl Manual"
1162HEADER
1163        if ($manpage);
1164
1165    while(<$fh>) {
1166        my $f = $_;
1167        chomp $f;
1168        if($f =~ /^#/) {
1169            # standard comment
1170            next;
1171        }
1172        if(/^%options/) {
1173            # output docs for all options
1174            foreach my $f (sort sortnames @files) {
1175                $ret += single($dir, $manpage, $f, 0);
1176            }
1177        }
1178        else {
1179            # render the file
1180            header($dir, $manpage, $f);
1181        }
1182    }
1183    close($fh);
1184    exit $ret if($ret);
1185}
1186
1187sub showonly {
1188    my ($dir, $f) = @_;
1189    if(single($dir, 1, $f, 1)) {
1190        print STDERR "$f: failed\n";
1191    }
1192}
1193
1194sub showprotocols {
1195    my %prots;
1196    foreach my $f (keys %optlong) {
1197        my @p = split(/ /, $protolong{$f});
1198        for my $p (@p) {
1199            $prots{$p}++;
1200        }
1201    }
1202    for(sort keys %prots) {
1203        printf "$_ (%d options)\n", $prots{$_};
1204    }
1205}
1206
1207sub getargs {
1208    my ($dir, $f, @s) = @_;
1209    if($f eq "mainpage") {
1210        listglobals($dir, @s);
1211        mainpage($dir, 1, @s);
1212        return;
1213    }
1214    elsif($f eq "ascii") {
1215        listglobals($dir, @s);
1216        mainpage($dir, 0, @s);
1217        return;
1218    }
1219    elsif($f eq "listhelp") {
1220        listhelp($dir);
1221        return;
1222    }
1223    elsif($f eq "single") {
1224        showonly($dir, $s[0]);
1225        return;
1226    }
1227    elsif($f eq "protos") {
1228        showprotocols();
1229        return;
1230    }
1231    elsif($f eq "listcats") {
1232        listcats();
1233        return;
1234    }
1235
1236    print "Usage: managen ".
1237        "[-d dir] <mainpage/ascii/listhelp/single FILE/protos/listcats> [files]\n";
1238}
1239
1240#------------------------------------------------------------------------
1241
1242my $dir = ".";
1243my $include = "../../include";
1244my $cmd = shift @ARGV;
1245
1246 check:
1247if($cmd eq "-d") {
1248    # specifies source directory
1249    $dir = shift @ARGV;
1250    $cmd = shift @ARGV;
1251    goto check;
1252}
1253elsif($cmd eq "-I") {
1254    # include path root
1255    $include = shift @ARGV;
1256    $cmd = shift @ARGV;
1257    goto check;
1258}
1259elsif($cmd eq "-c") {
1260    # Column width
1261    $colwidth = 0 + shift @ARGV;
1262    $cmd = shift @ARGV;
1263    goto check;
1264}
1265
1266my @files = @ARGV; # the rest are the files
1267
1268# can be overridden for releases
1269if($ENV{'CURL_MAKETGZ_VERSION'}) {
1270    $version = $ENV{'CURL_MAKETGZ_VERSION'};
1271}
1272else {
1273    open(INC, "<$include/curl/curlver.h");
1274    while(<INC>) {
1275        if($_ =~ /^#define LIBCURL_VERSION \"([0-9.]*)/) {
1276            $version = $1;
1277            last;
1278        }
1279    }
1280    close(INC);
1281}
1282
1283# learn all existing options
1284indexoptions($dir, @files);
1285
1286getargs($dir, $cmd, @files);
1287
1288exit $error;
1289