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