| #!/usr/bin/env perl |
| #*************************************************************************** |
| # _ _ ____ _ |
| # Project ___| | | | _ \| | |
| # / __| | | | |_) | | |
| # | (__| |_| | _ <| |___ |
| # \___|\___/|_| \_\_____| |
| # |
| # Copyright (C) 1998 - 2021, Daniel Stenberg, <[email protected]>, et al. |
| # |
| # This software is licensed as described in the file COPYING, which |
| # you should have received as part of this distribution. The terms |
| # are also available at https://curl.se/docs/copyright.html. |
| # |
| # You may opt to use, copy, modify, merge, publish, distribute and/or sell |
| # copies of the Software, and permit persons to whom the Software is |
| # furnished to do so, under the terms of the COPYING file. |
| # |
| # This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY |
| # KIND, either express or implied. |
| # |
| ########################################################################### |
| |
| =begin comment |
| |
| This script generates the manpage. |
| |
| Example: gen.pl <command> [files] > curl.1 |
| |
| Dev notes: |
| |
| We open *input* files in :crlf translation (a no-op on many platforms) in |
| case we have CRLF line endings in Windows but a perl that defaults to LF. |
| Unfortunately it seems some perls like msysgit can't handle a global input-only |
| :crlf so it has to be specified on each file open for text input. |
| |
| =end comment |
| =cut |
| |
| my %optshort; |
| my %optlong; |
| my %helplong; |
| my %arglong; |
| my %redirlong; |
| my %protolong; |
| my %catlong; |
| |
| # get the long name version, return the man page string |
| sub manpageify { |
| my ($k)=@_; |
| my $l; |
| if($optlong{$k} ne "") { |
| # both short + long |
| $l = "\\fI-".$optlong{$k}.", --$k\\fP"; |
| } |
| else { |
| # only long |
| $l = "\\fI--$k\\fP"; |
| } |
| return $l; |
| } |
| |
| sub printdesc { |
| my @desc = @_; |
| for my $d (@desc) { |
| if($d !~ /^.\\"/) { |
| # **bold** |
| $d =~ s/\*\*([^ ]*)\*\*/\\fB$1\\fP/g; |
| # *italics* |
| $d =~ s/\*([^ ]*)\*/\\fI$1\\fP/g; |
| } |
| # skip lines starting with space (examples) |
| if($d =~ /^[^ ]/) { |
| for my $k (keys %optlong) { |
| my $l = manpageify($k); |
| $d =~ s/--$k([^a-z0-9_-])/$l$1/; |
| } |
| } |
| # quote "bare" minuses in the output |
| $d =~ s/( |\\fI|^)--/$1\\-\\-/g; |
| $d =~ s/([ -]|\\fI|^)-/$1\\-/g; |
| print $d; |
| } |
| } |
| |
| sub seealso { |
| my($standalone, $data)=@_; |
| if($standalone) { |
| return sprintf |
| ".SH \"SEE ALSO\"\n$data\n"; |
| } |
| else { |
| return "See also $data. "; |
| } |
| } |
| |
| sub overrides { |
| my ($standalone, $data)=@_; |
| if($standalone) { |
| return ".SH \"OVERRIDES\"\n$data\n"; |
| } |
| else { |
| return $data; |
| } |
| } |
| |
| sub protocols { |
| my ($standalone, $data)=@_; |
| if($standalone) { |
| return ".SH \"PROTOCOLS\"\n$data\n"; |
| } |
| else { |
| return "($data) "; |
| } |
| } |
| |
| sub added { |
| my ($standalone, $data)=@_; |
| if($standalone) { |
| return ".SH \"ADDED\"\nAdded in curl version $data\n"; |
| } |
| else { |
| return "Added in $data. "; |
| } |
| } |
| |
| sub single { |
| my ($f, $standalone)=@_; |
| open(F, "<:crlf", "$f") || |
| return 1; |
| my $short; |
| my $long; |
| my $tags; |
| my $added; |
| my $protocols; |
| my $arg; |
| my $mutexed; |
| my $requires; |
| my $category; |
| my $seealso; |
| my $magic; # cmdline special option |
| while(<F>) { |
| if(/^Short: *(.)/i) { |
| $short=$1; |
| } |
| elsif(/^Long: *(.*)/i) { |
| $long=$1; |
| } |
| elsif(/^Added: *(.*)/i) { |
| $added=$1; |
| } |
| elsif(/^Tags: *(.*)/i) { |
| $tags=$1; |
| } |
| elsif(/^Arg: *(.*)/i) { |
| $arg=$1; |
| } |
| elsif(/^Magic: *(.*)/i) { |
| $magic=$1; |
| } |
| elsif(/^Mutexed: *(.*)/i) { |
| $mutexed=$1; |
| } |
| elsif(/^Protocols: *(.*)/i) { |
| $protocols=$1; |
| } |
| elsif(/^See-also: *(.*)/i) { |
| $seealso=$1; |
| } |
| elsif(/^Requires: *(.*)/i) { |
| $requires=$1; |
| } |
| elsif(/^Category: *(.*)/i) { |
| $category=$1; |
| } |
| elsif(/^Help: *(.*)/i) { |
| ; |
| } |
| elsif(/^---/) { |
| if(!$long) { |
| print STDERR "ERROR: no 'Long:' in $f\n"; |
| exit 1; |
| } |
| if(!$category) { |
| print STDERR "ERROR: no 'Category:' in $f\n"; |
| exit 2; |
| } |
| last; |
| } |
| else { |
| chomp; |
| print STDERR "WARN: unrecognized line in $f, ignoring:\n:'$_';" |
| } |
| } |
| my @desc; |
| while(<F>) { |
| push @desc, $_; |
| } |
| close(F); |
| my $opt; |
| if(defined($short) && $long) { |
| $opt = "-$short, --$long"; |
| } |
| elsif($short && !$long) { |
| $opt = "-$short"; |
| } |
| elsif($long && !$short) { |
| $opt = "--$long"; |
| } |
| |
| if($arg) { |
| $opt .= " $arg"; |
| } |
| |
| # quote "bare" minuses in opt |
| $opt =~ s/( |^)--/$1\\-\\-/g; |
| $opt =~ s/( |^)-/$1\\-/g; |
| if($standalone) { |
| print ".TH curl 1 \"30 Nov 2016\" \"curl 7.52.0\" \"curl manual\"\n"; |
| print ".SH OPTION\n"; |
| print "curl $opt\n"; |
| } |
| else { |
| print ".IP \"$opt\"\n"; |
| } |
| if($protocols) { |
| print protocols($standalone, $protocols); |
| } |
| |
| if($standalone) { |
| print ".SH DESCRIPTION\n"; |
| } |
| |
| printdesc(@desc); |
| undef @desc; |
| |
| my @foot; |
| if($seealso) { |
| my @m=split(/ /, $seealso); |
| my $mstr; |
| my $and = 0; |
| my $num = scalar(@m); |
| if($num > 2) { |
| # use commas up to this point |
| $and = $num - 1; |
| } |
| my $i = 0; |
| for my $k (@m) { |
| if(!$helplong{$k}) { |
| print STDERR "WARN: $f see-alsos a non-existing option: $k\n"; |
| } |
| my $l = manpageify($k); |
| my $sep = " and"; |
| if($and && ($i < $and)) { |
| $sep = ","; |
| } |
| $mstr .= sprintf "%s$l", $mstr?"$sep ":""; |
| $i++; |
| } |
| push @foot, seealso($standalone, $mstr); |
| } |
| if($requires) { |
| my $l = manpageify($long); |
| push @foot, "$l requires that the underlying libcurl". |
| " was built to support $requires. "; |
| } |
| if($mutexed) { |
| my @m=split(/ /, $mutexed); |
| my $mstr; |
| for my $k (@m) { |
| if(!$helplong{$k}) { |
| print STDERR "WARN: $f mutexes a non-existing option: $k\n"; |
| } |
| my $l = manpageify($k); |
| $mstr .= sprintf "%s$l", $mstr?" and ":""; |
| } |
| push @foot, overrides($standalone, "This option overrides $mstr. "); |
| } |
| if($added) { |
| push @foot, added($standalone, $added); |
| } |
| if($foot[0]) { |
| print "\n"; |
| my $f = join("", @foot); |
| $f =~ s/ +\z//; # remove trailing space |
| print "$f\n"; |
| } |
| return 0; |
| } |
| |
| sub getshortlong { |
| my ($f)=@_; |
| open(F, "<:crlf", "$f"); |
| my $short; |
| my $long; |
| my $help; |
| my $arg; |
| my $protocols; |
| my $category; |
| while(<F>) { |
| if(/^Short: (.)/i) { |
| $short=$1; |
| } |
| elsif(/^Long: (.*)/i) { |
| $long=$1; |
| } |
| elsif(/^Help: (.*)/i) { |
| $help=$1; |
| } |
| elsif(/^Arg: (.*)/i) { |
| $arg=$1; |
| } |
| elsif(/^Protocols: (.*)/i) { |
| $protocols=$1; |
| } |
| elsif(/^Category: (.*)/i) { |
| $category=$1; |
| } |
| elsif(/^---/) { |
| last; |
| } |
| } |
| close(F); |
| if($short) { |
| $optshort{$short}=$long; |
| } |
| if($long) { |
| $optlong{$long}=$short; |
| $helplong{$long}=$help; |
| $arglong{$long}=$arg; |
| $protolong{$long}=$protocols; |
| $catlong{$long}=$category; |
| } |
| } |
| |
| sub indexoptions { |
| my (@files) = @_; |
| foreach my $f (@files) { |
| getshortlong($f); |
| } |
| } |
| |
| sub header { |
| my ($f)=@_; |
| open(F, "<:crlf", "$f"); |
| my @d; |
| while(<F>) { |
| push @d, $_; |
| } |
| close(F); |
| printdesc(@d); |
| } |
| |
| sub listhelp { |
| foreach my $f (sort keys %helplong) { |
| my $long = $f; |
| my $short = $optlong{$long}; |
| my @categories = split ' ', $catlong{$long}; |
| my $bitmask; |
| my $opt; |
| |
| if(defined($short) && $long) { |
| $opt = "-$short, --$long"; |
| } |
| elsif($long && !$short) { |
| $opt = " --$long"; |
| } |
| for my $i (0 .. $#categories) { |
| $bitmask .= 'CURLHELP_' . uc $categories[$i]; |
| # If not last element, append | |
| if($i < $#categories) { |
| $bitmask .= ' | '; |
| } |
| } |
| my $arg = $arglong{$long}; |
| if($arg) { |
| $opt .= " $arg"; |
| } |
| my $desc = $helplong{$f}; |
| $desc =~ s/\"/\\\"/g; # escape double quotes |
| |
| my $line = sprintf " {\"%s\",\n \"%s\",\n %s},\n", $opt, $desc, $bitmask; |
| |
| if(length($opt) > 78) { |
| print STDERR "WARN: the --$long name is too long\n"; |
| } |
| elsif(length($desc) > 78) { |
| print STDERR "WARN: the --$long description is too long\n"; |
| } |
| print $line; |
| } |
| } |
| |
| sub listcats { |
| my %allcats; |
| foreach my $f (sort keys %helplong) { |
| my @categories = split ' ', $catlong{$f}; |
| foreach (@categories) { |
| $allcats{$_} = undef; |
| } |
| } |
| my @categories; |
| foreach my $key (keys %allcats) { |
| push @categories, $key; |
| } |
| @categories = sort @categories; |
| unshift @categories, 'hidden'; |
| for my $i (0..$#categories) { |
| print '#define ' . 'CURLHELP_' . uc($categories[$i]) . ' ' . "1u << " . $i . "u\n"; |
| } |
| } |
| |
| sub mainpage { |
| my (@files) = @_; |
| # show the page header |
| header("page-header"); |
| |
| # output docs for all options |
| foreach my $f (sort @files) { |
| if(single($f, 0)) { |
| print STDERR "Can't read $f?\n"; |
| } |
| } |
| |
| header("page-footer"); |
| } |
| |
| sub showonly { |
| my ($f) = @_; |
| if(single($f, 1)) { |
| print STDERR "$f: failed\n"; |
| } |
| } |
| |
| sub showprotocols { |
| my %prots; |
| foreach my $f (keys %optlong) { |
| my @p = split(/ /, $protolong{$f}); |
| for my $p (@p) { |
| $prots{$p}++; |
| } |
| } |
| for(sort keys %prots) { |
| printf "$_ (%d options)\n", $prots{$_}; |
| } |
| } |
| |
| sub getargs { |
| my ($f, @s) = @_; |
| if($f eq "mainpage") { |
| mainpage(@s); |
| return; |
| } |
| elsif($f eq "listhelp") { |
| listhelp(); |
| return; |
| } |
| elsif($f eq "single") { |
| showonly($s[0]); |
| return; |
| } |
| elsif($f eq "protos") { |
| showprotocols(); |
| return; |
| } |
| elsif($f eq "listcats") { |
| listcats(); |
| return; |
| } |
| |
| print "Usage: gen.pl <mainpage/listhelp/single FILE/protos/listcats> [files]\n"; |
| } |
| |
| #------------------------------------------------------------------------ |
| |
| my $cmd = shift @ARGV; |
| my @files = @ARGV; # the rest are the files |
| |
| # learn all existing options |
| indexoptions(@files); |
| |
| getargs($cmd, @files); |
