Annotation of embedaddon/curl/docs/cmdline-opts/gen.pl, revision 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>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to gen.pl CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / curl / docs / cmdline-opts