1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279 |
- #!/usr/bin/env perl
- #***************************************************************************
- # _ _ ____ _
- # Project ___| | | | _ \| |
- # / __| | | | |_) | |
- # | (__| |_| | _ <| |___
- # \___|\___/|_| \_\_____|
- #
- # Copyright (C) Daniel Stenberg, <daniel@haxx.se>, 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.
- #
- # SPDX-License-Identifier: curl
- #
- ###########################################################################
- =begin comment
- This script generates the manpage.
- Example: managen <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 cannot 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;
- use POSIX qw(strftime);
- my @ts;
- if (defined($ENV{SOURCE_DATE_EPOCH})) {
- @ts = gmtime($ENV{SOURCE_DATE_EPOCH});
- } else {
- @ts = localtime;
- }
- my $date = strftime "%Y-%m-%d", @ts;
- my $year = strftime "%Y", @ts;
- my $version = "unknown";
- my $globals;
- my $error = 0;
- my $indent = 4;
- # get the long name version, return the manpage string
- sub manpageify {
- my ($k)=@_;
- my $l;
- my $trail;
- # the matching pattern might include a trailing dot that cannot be part of
- # the option name
- if($k =~ s/\.$//) {
- # cut off trailing dot
- $trail = ".";
- }
- my $klong = $k;
- # quote "bare" minuses in the long name
- $klong =~ s/-/\\-/g;
- if($optlong{$k}) {
- # both short + long
- $l = "\\fI-".$optlong{$k}.", \\-\\-$klong\\fP$trail";
- }
- else {
- # only long
- $l = "\\fI\\-\\-$klong\\fP$trail";
- }
- return $l;
- }
- my $colwidth=79; # max number of columns
- sub prefixline {
- my ($num) = @_;
- print "\t" x ($num/8);
- print ' ' x ($num%8);
- }
- sub justline {
- my ($lvl, @line) = @_;
- my $w = -1;
- my $spaces = -1;
- my $width = $colwidth - ($lvl * $indent);
- for(@line) {
- $w += length($_);
- $w++;
- $spaces++;
- }
- my $inject = $width - $w;
- my $ratio = 0; # stay at zero if no spaces at all
- if($spaces) {
- $ratio = $inject / $spaces;
- }
- my $spare = 0;
- prefixline($lvl * $indent);
- my $prev;
- for(@line) {
- while($spare >= 0.90) {
- print " ";
- $spare--;
- }
- printf "%s%s", $prev?" ":"", $_;
- $prev = 1;
- $spare += $ratio;
- }
- print "\n";
- }
- sub lastline {
- my ($lvl, @line) = @_;
- $line[0] =~ s/^( +)//;
- prefixline($lvl * $indent + length($1));
- my $prev = 0;
- for(@line) {
- printf "%s%s", $prev?" ":"", $_;
- $prev = 1;
- }
- print "\n";
- }
- sub outputpara {
- my ($lvl, $f) = @_;
- $f =~ s/\n/ /g;
- my $w = 0;
- my @words = split(/ */, $f);
- my $width = $colwidth - ($lvl * $indent);
- my @line;
- for my $e (@words) {
- my $l = length($e);
- my $spaces = scalar(@line);
- if(($w + $l + $spaces) >= $width) {
- justline($lvl, @line);
- undef @line;
- $w = 0;
- }
- push @line, $e;
- $w += $l; # new width
- }
- if($w) {
- lastline($lvl, @line);
- print "\n";
- }
- }
- sub printdesc {
- my ($manpage, $baselvl, @desc) = @_;
- if($manpage) {
- for my $d (@desc) {
- print $d;
- }
- }
- else {
- my $p = -1;
- my $para;
- for my $l (@desc) {
- my $lvl;
- if($l !~ /^[\n\r]+/) {
- # get the indent level off the string
- $l =~ s/^\[([0-9q]*)\]//;
- $lvl = $1;
- }
- if(($p =~ /q/) && ($lvl !~ /q/)) {
- # the previous was quoted, this is not
- print "\n";
- }
- if($lvl != $p) {
- outputpara($baselvl + $p, $para);
- $para = "";
- }
- if($lvl =~ /q/) {
- # quoted, do not right-justify
- chomp $l;
- lastline($baselvl + $lvl + 1, $l);
- my $w = ($baselvl + $lvl + 1) * $indent + length($l);
- if ($w > $colwidth) {
- print STDERR "ERROR: $w columns is too long\n";
- print STDERR "$l\n";
- $error++;
- }
- }
- else {
- $para .= $l;
- }
- $p = $lvl;
- }
- outputpara($baselvl + $p, $para);
- }
- }
- 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 ($manpage, $standalone, $data)=@_;
- if($standalone) {
- return ".SH \"PROTOCOLS\"\n$data\n";
- }
- else {
- return "($data) " if($manpage);
- return "[1]($data) " if(!$manpage);
- }
- }
- sub too_old {
- my ($version)=@_;
- my $a = 999999;
- if($version =~ /^(\d+)\.(\d+)\.(\d+)/) {
- $a = $1 * 1000 + $2 * 10 + $3;
- }
- elsif($version =~ /^(\d+)\.(\d+)/) {
- $a = $1 * 1000 + $2 * 10;
- }
- if($a < 7600) {
- # we consider everything before 7.60.0 to be too old to mention
- # specific changes for
- return 1;
- }
- return 0;
- }
- sub added {
- my ($standalone, $data)=@_;
- if(too_old($data)) {
- # do not mention ancient additions
- return "";
- }
- if($standalone) {
- return ".SH \"ADDED\"\nAdded in curl version $data\n";
- }
- else {
- return "Added in $data. ";
- }
- }
- sub render {
- my ($manpage, $fh, $f, $line) = @_;
- my @desc;
- my $tablemode = 0;
- my $header = 0;
- # if $top is TRUE, it means a top-level page and not a command line option
- my $top = ($line == 1);
- my $quote;
- my $level;
- my $finalblank;
- $start = 0;
- while(<$fh>) {
- my $d = $_;
- $line++;
- $finalblank = ($d eq "\n");
- if($d =~ /^\.(SH|BR|IP|B)/) {
- print STDERR "$f:$line:1:ERROR: nroff instruction in input: \".$1\"\n";
- return 4;
- }
- if(/^ *<!--/) {
- # skip comments
- next;
- }
- if((!$start) && ($_ =~ /^[\r\n]*\z/)) {
- # skip leading blank lines
- next;
- }
- $start = 1;
- if(/^# (.*)/) {
- $header = 1;
- if($top != 1) {
- # ignored for command line options
- $blankline++;
- next;
- }
- push @desc, ".SH $1\n" if($manpage);
- push @desc, "[0]$1\n" if(!$manpage);
- next;
- }
- elsif(/^###/) {
- print STDERR "$f:$line:1:ERROR: ### header is not supported\n";
- exit 3;
- }
- elsif(/^## (.*)/) {
- my $word = $1;
- # if there are enclosing quotes, remove them first
- $word =~ s/[\"\'](.*)[\"\']\z/$1/;
- # remove backticks from headers
- $word =~ s/\`//g;
- # if there is a space, it needs quotes for manpage
- if(($word =~ / /) && $manpage) {
- $word = "\"$word\"";
- }
- $level = 1;
- if($top == 1) {
- push @desc, ".IP $word\n" if($manpage);
- push @desc, "\n" if(!$manpage);
- push @desc, "[1]$word\n" if(!$manpage);
- }
- else {
- if(!$tablemode) {
- push @desc, ".RS\n" if($manpage);
- $tablemode = 1;
- }
- push @desc, ".IP $word\n" if($manpage);
- push @desc, "\n" if(!$manpage);
- push @desc, "[1]$word\n" if(!$manpage);
- }
- $header = 1;
- next;
- }
- elsif(/^##/) {
- if($top == 1) {
- print STDERR "$f:$line:1:ERROR: ## empty header top-level mode\n";
- exit 3;
- }
- if($tablemode) {
- # end of table
- push @desc, ".RE\n.IP\n" if($manpage);
- $tablemode = 0;
- }
- $header = 1;
- next;
- }
- elsif(/^\.(IP|RS|RE)/) {
- my ($cmd) = ($1);
- print STDERR "$f:$line:1:ERROR: $cmd detected, use ##-style\n";
- return 3;
- }
- elsif(/^[ \t]*\n/) {
- # count and ignore blank lines
- $blankline++;
- next;
- }
- elsif($d =~ /^ (.*)/) {
- my $word = $1;
- if(!$quote && $manpage) {
- push @desc, "\n" if($blankline);
- push @desc, ".nf\n";
- $blankline = 0;
- }
- $quote = 1;
- $d = "$word\n";
- }
- elsif($quote && ($d !~ /^ (.*)/)) {
- # end of quote
- push @desc, ".fi\n" if($manpage);
- $quote = 0;
- }
- $d =~ s/`%DATE`/$date/g;
- $d =~ s/`%VERSION`/$version/g;
- $d =~ s/`%GLOBALS`/$globals/g;
- # convert backticks to double quotes
- $d =~ s/\`/\"/g;
- if($d =~ /\(added in(.*)/i) {
- if(length($1) < 2) {
- print STDERR "$f:$line:1:ERROR: broken up added-in line:\n";
- print STDERR "$f:$line:1:ERROR: $d";
- return 3;
- }
- }
- again:
- if($d =~ /\(Added in ([0-9.]+)\)/i) {
- my $ver = $1;
- if(too_old($ver)) {
- $d =~ s/ *\(Added in $ver\)//gi;
- goto again;
- }
- }
- if(!$quote) {
- if($d =~ /^(.*) /) {
- printf STDERR "$f:$line:%d:ERROR: 2 spaces detected\n",
- length($1);
- return 3;
- }
- elsif($d =~ /[^\\][\<\>]/) {
- print STDERR "$f:$line:1:WARN: un-escaped < or > used\n";
- return 3;
- }
- }
- # convert backslash-'<' or '> to just the second character
- $d =~ s/\\([><])/$1/g;
- # convert single backslash to double-backslash
- $d =~ s/\\/\\\\/g if($manpage);
- if($manpage) {
- if(!$quote && $d =~ /--/) {
- $d =~ s/--([a-z0-9.-]+)/manpageify($1)/ge;
- }
- # quote minuses in the output
- $d =~ s/([^\\])-/$1\\-/g;
- # replace single quotes
- $d =~ s/\'/\\(aq/g;
- # handle double quotes or periods first on the line
- $d =~ s/^([\.\"])/\\&$1/;
- # **bold**
- $d =~ s/\*\*(\S.*?)\*\*/\\fB$1\\fP/g;
- # *italics*
- $d =~ s/\*(\S.*?)\*/\\fI$1\\fP/g;
- }
- else {
- # **bold**
- $d =~ s/\*\*(\S.*?)\*\*/$1/g;
- # *italics*
- $d =~ s/\*(\S.*?)\*/$1/g;
- }
- # trim trailing spaces
- $d =~ s/[ \t]+\z//;
- push @desc, "\n" if($blankline && !$header);
- $blankline = 0;
- push @desc, $d if($manpage);
- my $qstr = $quote ? "q": "";
- push @desc, "[".(1 + $level)."$qstr]$d" if(!$manpage);
- $header = 0;
- }
- if($finalblank) {
- print STDERR "$f:$line:1:ERROR: trailing blank line\n";
- exit 3;
- }
- if($quote) {
- # don't leave the quote "hanging"
- push @desc, ".fi\n" if($manpage);
- }
- if($tablemode) {
- # end of table
- push @desc, ".RE\n.IP\n" if($manpage);
- }
- return @desc;
- }
- sub maybespace {
- my ($string) = @_;
- if(($string =~ /(.* )(.*)/) &&
- (length($2) <= 20)) {
- return $1;
- }
- if(($string =~ /(.*:)(.*)/) &&
- (length($2) <= 20)) {
- return $1;
- }
- return $string;
- }
- sub single {
- my ($dir, $manpage, $f, $standalone)=@_;
- my $fh;
- open($fh, "<:crlf", "$dir/$f") ||
- die "could not find $dir/$f";
- my $short;
- my $long;
- my $tags;
- my $added;
- my $protocols;
- my $arg;
- my $mutexed;
- my $requires;
- my $category;
- my @seealso;
- my $copyright;
- my $spdx;
- my @examples; # there can be more than one
- my $magic; # cmdline special option
- my $line;
- my $dline;
- my $multi;
- my $scope;
- my $experimental;
- my $start;
- my $list; # identifies the list, 1 example, 2 see-also
- while(<$fh>) {
- $line++;
- if(/^ *<!--/) {
- next;
- }
- if(!$start) {
- if(/^---/) {
- $start = 1;
- }
- next;
- }
- 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) {
- if($seealso) {
- print STDERR "ERROR: duplicated See-also in $f\n";
- return 1;
- }
- push @seealso, $1;
- }
- elsif(/^See-also:/i) {
- $list=2;
- }
- elsif(/^ *- (.*)/i && ($list == 2)) {
- push @seealso, $1;
- }
- elsif(/^Requires: *(.*)/i) {
- $requires=$1;
- }
- elsif(/^Category: *(.*)/i) {
- $category=$1;
- }
- elsif(/^Example: +(.+)/i) {
- push @examples, $1;
- }
- elsif(/^Example:/i) {
- # '1' is the example list
- $list = 1;
- }
- elsif(/^ *- (.*)/i && ($list == 1)) {
- push @examples, $1;
- }
- elsif(/^Multi: *(.*)/i) {
- $multi=$1;
- }
- elsif(/^Scope: *(.*)/i) {
- $scope=$1;
- }
- elsif(/^Experimental: yes/i) {
- $experimental=1;
- }
- elsif(/^C: (.*)/i) {
- $copyright=$1;
- }
- elsif(/^SPDX-License-Identifier: (.*)/i) {
- $spdx=$1;
- }
- elsif(/^Help: *(.*)/i) {
- ;
- }
- elsif(/^---/) {
- $start++;
- if(!$long) {
- print STDERR "ERROR: no 'Long:' in $f\n";
- return 1;
- }
- if(!$category) {
- print STDERR "ERROR: no 'Category:' in $f\n";
- return 2;
- }
- if(!$examples[0]) {
- print STDERR "$f:$line:1:ERROR: no 'Example:' present\n";
- return 2;
- }
- if(!$added) {
- print STDERR "$f:$line:1:ERROR: no 'Added:' version present\n";
- return 2;
- }
- if(!$seealso[0]) {
- print STDERR "$f:$line:1:ERROR: no 'See-also:' field present\n";
- return 2;
- }
- if(!$copyright) {
- print STDERR "$f:$line:1:ERROR: no 'C:' field present\n";
- return 2;
- }
- if(!$spdx) {
- print STDERR "$f:$line:1:ERROR: no 'SPDX-License-Identifier:' field present\n";
- return 2;
- }
- last;
- }
- else {
- chomp;
- print STDERR "$f:$line:1:WARN: unrecognized line in $f, ignoring:\n:'$_';"
- }
- }
- if($start < 2) {
- print STDERR "$f:1:1:ERROR: no proper meta-data header\n";
- return 2;
- }
- my @desc = render($manpage, $fh, $f, $line);
- close($fh);
- if($tablemode) {
- # end of table
- push @desc, ".RE\n.IP\n";
- }
- 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/-/\\-/g if($manpage);
- if($standalone) {
- print ".TH curl 1 \"30 Nov 2016\" \"curl 7.52.0\" \"curl manual\"\n";
- print ".SH OPTION\n";
- print "curl $opt\n";
- }
- elsif($manpage) {
- print ".IP \"$opt\"\n";
- }
- else {
- lastline(1, $opt);
- }
- my @leading;
- if($protocols) {
- push @leading, protocols($manpage, $standalone, $protocols);
- }
- if($standalone) {
- print ".SH DESCRIPTION\n";
- }
- if($experimental) {
- push @leading, "**WARNING**: this option is experimental. Do not use in production.\n\n";
- }
- my $pre = $manpage ? "\n": "[1]";
- if($scope) {
- if($category !~ /global/) {
- print STDERR "$f:$line:1:ERROR: global scope option does not have global category\n";
- return 2;
- }
- if($scope eq "global") {
- push @desc, "\n" if(!$manpage);
- push @desc, "${pre}This option is global and does not need to be specified for each use of --next.\n";
- }
- else {
- print STDERR "$f:$line:1:ERROR: unrecognized scope: '$scope'\n";
- return 2;
- }
- }
- my @extra;
- if($multi eq "single") {
- push @extra, "${pre}If --$long is provided several times, the last set ".
- "value is used.\n";
- }
- elsif($multi eq "append") {
- push @extra, "${pre}--$long can be used several times in a command line\n";
- }
- elsif($multi eq "boolean") {
- my $rev = "no-$long";
- # for options that start with "no-" the reverse is then without
- # the no- prefix
- if($long =~ /^no-/) {
- $rev = $long;
- $rev =~ s/^no-//;
- }
- my $dashes = $manpage ? "\\-\\-" : "--";
- push @extra,
- "${pre}Providing --$long multiple times has no extra effect.\n".
- "Disable it again with $dashes$rev.\n";
- }
- elsif($multi eq "mutex") {
- push @extra,
- "${pre}Providing --$long multiple times has no extra effect.\n";
- }
- elsif($multi eq "custom") {
- ; # left for the text to describe
- }
- elsif($multi eq "per-URL") {
- push @extra,
- "${pre}--$long is associated with a single URL. Use it once per URL ".
- "when you use several URLs in a command line.\n";
- }
- else {
- print STDERR "$f:$line:1:ERROR: unrecognized Multi: '$multi'\n";
- return 2;
- }
- printdesc($manpage, 2, (@leading, @desc, @extra));
- undef @desc;
- my @foot;
- my $mstr;
- my $and = 0;
- my $num = scalar(@seealso);
- if($num > 2) {
- # use commas up to this point
- $and = $num - 1;
- }
- my $i = 0;
- for my $k (@seealso) {
- if(!$helplong{$k}) {
- print STDERR "$f:$line:1:WARN: see-also a non-existing option: $k\n";
- }
- my $l = $manpage ? manpageify($k) : "--$k";
- my $sep = " and";
- if($and && ($i < $and)) {
- $sep = ",";
- }
- $mstr .= sprintf "%s$l", $mstr?"$sep ":"";
- $i++;
- }
- if($requires) {
- my $l = $manpage ? manpageify($long) : "--$long";
- push @foot, "$l requires that libcurl".
- " is built to support $requires.\n";
- }
- if($mutexed) {
- my @m=split(/ /, $mutexed);
- my $mstr;
- my $num = scalar(@m);
- my $count;
- for my $k (@m) {
- if(!$helplong{$k}) {
- print STDERR "WARN: $f mutexes a non-existing option: $k\n";
- }
- my $l = $manpage ? manpageify($k) : "--$k";
- my $sep = ", ";
- if($count == ($num -1)) {
- $sep = " and ";
- }
- $mstr .= sprintf "%s$l", $mstr?$sep:"";
- $count++;
- }
- push @foot, overrides($standalone,
- "This option is mutually exclusive with $mstr.\n");
- }
- if($examples[0]) {
- my $s ="";
- $s="s" if($examples[1]);
- if($manpage) {
- print "\nExample$s:\n";
- print ".nf\n";
- foreach my $e (@examples) {
- $e =~ s!\$URL!https://example.com!g;
- # convert single backslahes to doubles
- $e =~ s/\\/\\\\/g;
- print "curl $e\n";
- }
- print ".fi\n";
- }
- else {
- my @ex;
- push @ex, "[0q]Example$s:\n";
- #
- # long ASCII examples are wrapped. Preferably at the last space
- # before the margin. Or at a colon. Otherwise it just cuts at the
- # exact boundary.
- #
- foreach my $e (@examples) {
- $e =~ s!\$URL!https://example.com!g;
- my $maxwidth = 60; # plus the " curl " 18 col prefix
- if(length($e) > $maxwidth) {
- # a long example, shorten it
- my $p = substr($e, 0, $maxwidth);
- $p = maybespace($p);
- push @ex, "[0q] curl ".$p."\\";
- $e = substr($e, length($p));
- do {
- my $r = substr($e, 0, $maxwidth);
- if(length($e) > $maxwidth) {
- $r = maybespace($r);
- }
- my $slash ="";
- $e = substr($e, length($r));
- if(length($e) > 0) {
- $slash = "\\";
- }
- push @ex, "[0q] $r$slash" if($r);
- } while(length($e));
- }
- else {
- push @ex, "[0q] curl $e\n";
- }
- }
- printdesc($manpage, 2, @ex);
- }
- }
- if($added) {
- push @foot, added($standalone, $added);
- }
- push @foot, seealso($standalone, $mstr);
- print "\n";
- my $f = join("", @foot);
- if($manpage) {
- $f =~ s/ +\z//; # remove trailing space
- print "$f\n";
- }
- else {
- printdesc($manpage, 2, "[1]$f");
- }
- return 0;
- }
- sub getshortlong {
- my ($dir, $f)=@_;
- $f =~ s/^.*\///;
- open(F, "<:crlf", "$dir/$f") ||
- die "could not find $dir/$f";
- my $short;
- my $long;
- my $help;
- my $arg;
- my $protocols;
- my $category;
- my $start = 0;
- my $line = 0;
- while(<F>) {
- $line++;
- if(!$start) {
- if(/^---/) {
- $start = 1;
- }
- next;
- }
- if(/^Short: (.)/i) {
- $short=$1;
- }
- elsif(/^Long: (.*)/i) {
- $long=$1;
- }
- elsif(/^Help: (.*)/i) {
- $help=$1;
- my $len = length($help);
- if($len >= 49) {
- printf STDERR "$f:$line:1:WARN: oversized help text: %d characters\n",
- $len;
- }
- }
- 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 ($dir, @files) = @_;
- foreach my $f (@files) {
- getshortlong($dir, $f);
- }
- }
- sub header {
- my ($dir, $manpage, $f)=@_;
- my $fh;
- open($fh, "<:crlf", "$dir/$f") ||
- die "could not find $dir/$f";
- my @d = render($manpage, $fh, $f, 1);
- close($fh);
- printdesc($manpage, 0, @d);
- }
- sub sourcecategories {
- my ($dir) = @_;
- my %cats;
- open(H, "<$dir/../../src/tool_help.h") ||
- die "can't find the header file";
- while(<H>) {
- if(/^\#define CURLHELP_([A-Z0-9]*)/) {
- $cats{lc($1)}++;
- }
- }
- close(H);
- return %cats;
- }
- sub listhelp {
- my ($dir) = @_;
- my %cats = sourcecategories($dir);
- print <<HEAD
- /***************************************************************************
- * _ _ ____ _
- * Project ___| | | | _ \\| |
- * / __| | | | |_) | |
- * | (__| |_| | _ <| |___
- * \\___|\\___/|_| \\_\\_____|
- *
- * Copyright (C) Daniel Stenberg, <daniel\@haxx.se>, 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.
- *
- * SPDX-License-Identifier: curl
- *
- ***************************************************************************/
- #include "tool_setup.h"
- #include "tool_help.h"
- /*
- * DO NOT edit tool_listhelp.c manually.
- * This source file is generated with the following command in an autotools
- * build:
- *
- * "make listhelp"
- */
- const struct helptxt helptext[] = {
- HEAD
- ;
- 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) {
- if(!$cats{ $categories[$i] }) {
- printf STDERR "$f.md:ERROR: Unknown category '%s'\n",
- $categories[$i];
- exit 3;
- }
- $bitmask .= 'CURLHELP_' . uc $categories[$i];
- # If not last element, append |
- if($i < $#categories) {
- $bitmask .= ' | ';
- }
- }
- $bitmask =~ s/(?=.{76}).{1,76}\|/$&\n /g;
- 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;
- }
- print <<FOOT
- { NULL, NULL, 0 }
- };
- FOOT
- ;
- }
- 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;
- for my $i (0..$#categories) {
- printf("#define CURLHELP_%-10s (%s)\n",
- uc($categories[$i]), "1u << ${i}u");
- }
- }
- sub listglobals {
- my ($dir, @files) = @_;
- my @globalopts;
- # Find all global options and output them
- foreach my $f (sort @files) {
- open(F, "<:crlf", "$dir/$f") ||
- die "could not read $dir/$f";
- my $long;
- my $start = 0;
- while(<F>) {
- if(/^---/) {
- if(!$start) {
- $start = 1;
- next;
- }
- else {
- last;
- }
- }
- if(/^Long: *(.*)/i) {
- $long=$1;
- }
- elsif(/^Scope: global/i) {
- push @globalopts, $long;
- last;
- }
- }
- close(F);
- }
- return $ret if($ret);
- for my $e (0 .. $#globalopts) {
- $globals .= sprintf "%s--%s", $e?($globalopts[$e+1] ? ", " : " and "):"",
- $globalopts[$e],;
- }
- }
- sub noext {
- my $in = $_[0];
- $in =~ s/\.md//;
- return $in;
- }
- sub sortnames {
- return noext($a) cmp noext($b);
- }
- sub mainpage {
- my ($dir, $manpage, @files) = @_;
- # $manpage is 1 for nroff, 0 for ASCII
- my $ret;
- my $fh;
- open($fh, "<:crlf", "$dir/mainpage.idx") ||
- die "no $dir/mainpage.idx file";
- print <<HEADER
- .\\" **************************************************************************
- .\\" * _ _ ____ _
- .\\" * Project ___| | | | _ \\| |
- .\\" * / __| | | | |_) | |
- .\\" * | (__| |_| | _ <| |___
- .\\" * \\___|\\___/|_| \\_\\_____|
- .\\" *
- .\\" * Copyright (C) Daniel Stenberg, <daniel\@haxx.se>, 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.
- .\\" *
- .\\" * SPDX-License-Identifier: curl
- .\\" *
- .\\" **************************************************************************
- .\\"
- .\\" DO NOT EDIT. Generated by the curl project managen manpage generator.
- .\\"
- .TH curl 1 "$date" "curl $version" "curl Manual"
- HEADER
- if ($manpage);
- while(<$fh>) {
- my $f = $_;
- chomp $f;
- if($f =~ /^#/) {
- # standard comment
- next;
- }
- if(/^%options/) {
- # output docs for all options
- foreach my $f (sort sortnames @files) {
- $ret += single($dir, $manpage, $f, 0);
- }
- }
- else {
- # render the file
- header($dir, $manpage, $f);
- }
- }
- close($fh);
- exit $ret if($ret);
- }
- 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 ($dir, $f, @s) = @_;
- if($f eq "mainpage") {
- listglobals($dir, @s);
- mainpage($dir, 1, @s);
- return;
- }
- elsif($f eq "ascii") {
- listglobals($dir, @s);
- mainpage($dir, 0, @s);
- return;
- }
- elsif($f eq "listhelp") {
- listhelp($dir);
- return;
- }
- elsif($f eq "single") {
- showonly($s[0]);
- return;
- }
- elsif($f eq "protos") {
- showprotocols();
- return;
- }
- elsif($f eq "listcats") {
- listcats();
- return;
- }
- print "Usage: managen ".
- "[-d dir] <mainpage/ascii/listhelp/single FILE/protos/listcats> [files]\n";
- }
- #------------------------------------------------------------------------
- my $dir = ".";
- my $include = "../../include";
- my $cmd = shift @ARGV;
- check:
- if($cmd eq "-d") {
- # specifies source directory
- $dir = shift @ARGV;
- $cmd = shift @ARGV;
- goto check;
- }
- elsif($cmd eq "-I") {
- # include path root
- $include = shift @ARGV;
- $cmd = shift @ARGV;
- goto check;
- }
- elsif($cmd eq "-c") {
- # Column width
- $colwidth = 0 + shift @ARGV;
- $cmd = shift @ARGV;
- goto check;
- }
- my @files = @ARGV; # the rest are the files
- # can be overridden for releases
- if($ENV{'CURL_MAKETGZ_VERSION'}) {
- $version = $ENV{'CURL_MAKETGZ_VERSION'};
- }
- else {
- open(INC, "<$include/curl/curlver.h");
- while(<INC>) {
- if($_ =~ /^#define LIBCURL_VERSION \"([0-9.]*)/) {
- $version = $1;
- last;
- }
- }
- close(INC);
- }
- # learn all existing options
- indexoptions($dir, @files);
- getargs($dir, $cmd, @files);
- exit $error;
|