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 26This script generates the manpage. 27 28Example: gen.pl <command> [files] > curl.1 29 30Dev notes: 31 32We open *input* files in :crlf translation (a no-op on many platforms) in 33case we have CRLF line endings in Windows but a perl that defaults to LF. 34Unfortunately 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 40my %optshort; 41my %optlong; 42my %helplong; 43my %arglong; 44my %redirlong; 45my %protolong; 46my %catlong; 47 48# get the long name version, return the man page string 49sub manpageify { 50 my ($k)=@_; 51 my $l; 52 if($optlong{$k} ne "") { 53 # both short + long 54 $l = "\\fI-".$optlong{$k}.", --$k\\fP"; 55 } 56 else { 57 # only long 58 $l = "\\fI--$k\\fP"; 59 } 60 return $l; 61} 62 63sub printdesc { 64 my @desc = @_; 65 for my $d (@desc) { 66 # skip lines starting with space (examples) 67 if($d =~ /^[^ ]/) { 68 for my $k (keys %optlong) { 69 my $l = manpageify($k); 70 $d =~ s/--$k([^a-z0-9_-])/$l$1/; 71 } 72 } 73 print $d; 74 } 75} 76 77sub seealso { 78 my($standalone, $data)=@_; 79 if($standalone) { 80 return sprintf 81 ".SH \"SEE ALSO\"\n$data\n"; 82 } 83 else { 84 return "See also $data. "; 85 } 86} 87 88sub overrides { 89 my ($standalone, $data)=@_; 90 if($standalone) { 91 return ".SH \"OVERRIDES\"\n$data\n"; 92 } 93 else { 94 return $data; 95 } 96} 97 98sub protocols { 99 my ($standalone, $data)=@_; 100 if($standalone) { 101 return ".SH \"PROTOCOLS\"\n$data\n"; 102 } 103 else { 104 return "($data) "; 105 } 106} 107 108sub added { 109 my ($standalone, $data)=@_; 110 if($standalone) { 111 return ".SH \"ADDED\"\nAdded in curl version $data\n"; 112 } 113 else { 114 return "Added in $data. "; 115 } 116} 117 118sub single { 119 my ($f, $standalone)=@_; 120 open(F, "<:crlf", "$f") || 121 return 1; 122 my $short; 123 my $long; 124 my $tags; 125 my $added; 126 my $protocols; 127 my $arg; 128 my $mutexed; 129 my $requires; 130 my $category; 131 my $seealso; 132 my $magic; # cmdline special option 133 while(<F>) { 134 if(/^Short: *(.)/i) { 135 $short=$1; 136 } 137 elsif(/^Long: *(.*)/i) { 138 $long=$1; 139 } 140 elsif(/^Added: *(.*)/i) { 141 $added=$1; 142 } 143 elsif(/^Tags: *(.*)/i) { 144 $tags=$1; 145 } 146 elsif(/^Arg: *(.*)/i) { 147 $arg=$1; 148 } 149 elsif(/^Magic: *(.*)/i) { 150 $magic=$1; 151 } 152 elsif(/^Mutexed: *(.*)/i) { 153 $mutexed=$1; 154 } 155 elsif(/^Protocols: *(.*)/i) { 156 $protocols=$1; 157 } 158 elsif(/^See-also: *(.*)/i) { 159 $seealso=$1; 160 } 161 elsif(/^Requires: *(.*)/i) { 162 $requires=$1; 163 } 164 elsif(/^Category: *(.*)/i) { 165 $category=$1; 166 } 167 elsif(/^Help: *(.*)/i) { 168 ; 169 } 170 elsif(/^---/) { 171 if(!$long) { 172 print STDERR "WARN: no 'Long:' in $f\n"; 173 } 174 if(!$category) { 175 print STDERR "WARN: no 'Category:' in $f\n"; 176 } 177 last; 178 } 179 else { 180 chomp; 181 print STDERR "WARN: unrecognized line in $f, ignoring:\n:'$_';" 182 } 183 } 184 my @desc; 185 while(<F>) { 186 push @desc, $_; 187 } 188 close(F); 189 my $opt; 190 if(defined($short) && $long) { 191 $opt = "-$short, --$long"; 192 } 193 elsif($short && !$long) { 194 $opt = "-$short"; 195 } 196 elsif($long && !$short) { 197 $opt = "--$long"; 198 } 199 200 if($arg) { 201 $opt .= " $arg"; 202 } 203 204 if($standalone) { 205 print ".TH curl 1 \"30 Nov 2016\" \"curl 7.52.0\" \"curl manual\"\n"; 206 print ".SH OPTION\n"; 207 print "curl $opt\n"; 208 } 209 else { 210 print ".IP \"$opt\"\n"; 211 } 212 if($protocols) { 213 print protocols($standalone, $protocols); 214 } 215 216 if($standalone) { 217 print ".SH DESCRIPTION\n"; 218 } 219 220 printdesc(@desc); 221 undef @desc; 222 223 my @foot; 224 if($seealso) { 225 my @m=split(/ /, $seealso); 226 my $mstr; 227 my $and = 0; 228 my $num = scalar(@m); 229 if($num > 2) { 230 # use commas up to this point 231 $and = $num - 1; 232 } 233 my $i = 0; 234 for my $k (@m) { 235 if(!$helplong{$k}) { 236 print STDERR "WARN: $f see-alsos a non-existing option: $k\n"; 237 } 238 my $l = manpageify($k); 239 my $sep = " and"; 240 if($and && ($i < $and)) { 241 $sep = ","; 242 } 243 $mstr .= sprintf "%s$l", $mstr?"$sep ":""; 244 $i++; 245 } 246 push @foot, seealso($standalone, $mstr); 247 } 248 if($requires) { 249 my $l = manpageify($long); 250 push @foot, "$l requires that the underlying libcurl". 251 " was built to support $requires. "; 252 } 253 if($mutexed) { 254 my @m=split(/ /, $mutexed); 255 my $mstr; 256 for my $k (@m) { 257 if(!$helplong{$k}) { 258 print STDERR "WARN: $f mutexes a non-existing option: $k\n"; 259 } 260 my $l = manpageify($k); 261 $mstr .= sprintf "%s$l", $mstr?" and ":""; 262 } 263 push @foot, overrides($standalone, "This option overrides $mstr. "); 264 } 265 if($added) { 266 push @foot, added($standalone, $added); 267 } 268 if($foot[0]) { 269 print "\n"; 270 my $f = join("", @foot); 271 $f =~ s/ +\z//; # remove trailing space 272 print "$f\n"; 273 } 274 return 0; 275} 276 277sub getshortlong { 278 my ($f)=@_; 279 open(F, "<:crlf", "$f"); 280 my $short; 281 my $long; 282 my $help; 283 my $arg; 284 my $protocols; 285 my $category; 286 while(<F>) { 287 if(/^Short: (.)/i) { 288 $short=$1; 289 } 290 elsif(/^Long: (.*)/i) { 291 $long=$1; 292 } 293 elsif(/^Help: (.*)/i) { 294 $help=$1; 295 } 296 elsif(/^Arg: (.*)/i) { 297 $arg=$1; 298 } 299 elsif(/^Protocols: (.*)/i) { 300 $protocols=$1; 301 } 302 elsif(/^Category: (.*)/i) { 303 $category=$1; 304 } 305 elsif(/^---/) { 306 last; 307 } 308 } 309 close(F); 310 if($short) { 311 $optshort{$short}=$long; 312 } 313 if($long) { 314 $optlong{$long}=$short; 315 $helplong{$long}=$help; 316 $arglong{$long}=$arg; 317 $protolong{$long}=$protocols; 318 $catlong{$long}=$category; 319 } 320} 321 322sub indexoptions { 323 my (@files) = @_; 324 foreach my $f (@files) { 325 getshortlong($f); 326 } 327} 328 329sub header { 330 my ($f)=@_; 331 open(F, "<:crlf", "$f"); 332 my @d; 333 while(<F>) { 334 push @d, $_; 335 } 336 close(F); 337 printdesc(@d); 338} 339 340sub listhelp { 341 foreach my $f (sort keys %helplong) { 342 my $long = $f; 343 my $short = $optlong{$long}; 344 my @categories = split ' ', $catlong{$long}; 345 my $bitmask; 346 my $opt; 347 348 if(defined($short) && $long) { 349 $opt = "-$short, --$long"; 350 } 351 elsif($long && !$short) { 352 $opt = " --$long"; 353 } 354 for my $i (0 .. $#categories) { 355 $bitmask .= 'CURLHELP_' . uc $categories[$i]; 356 # If not last element, append | 357 if($i < $#categories) { 358 $bitmask .= ' | '; 359 } 360 } 361 my $arg = $arglong{$long}; 362 if($arg) { 363 $opt .= " $arg"; 364 } 365 my $desc = $helplong{$f}; 366 $desc =~ s/\"/\\\"/g; # escape double quotes 367 368 my $line = sprintf " {\"%s\",\n \"%s\",\n %s},\n", $opt, $desc, $bitmask; 369 370 if(length($opt) + length($desc) > 78) { 371 print STDERR "WARN: the --$long line is too long\n"; 372 } 373 print $line; 374 } 375} 376 377sub listcats { 378 my %allcats; 379 foreach my $f (sort keys %helplong) { 380 my @categories = split ' ', $catlong{$f}; 381 foreach (@categories) { 382 $allcats{$_} = undef; 383 } 384 } 385 my @categories; 386 foreach my $key (keys %allcats) { 387 push @categories, $key; 388 } 389 @categories = sort @categories; 390 unshift @categories, 'hidden'; 391 for my $i (0..$#categories) { 392 print '#define ' . 'CURLHELP_' . uc($categories[$i]) . ' ' . "1u << " . $i . "u\n"; 393 } 394} 395 396sub mainpage { 397 my (@files) = @_; 398 # show the page header 399 header("page-header"); 400 401 # output docs for all options 402 foreach my $f (sort @files) { 403 if(single($f, 0)) { 404 print STDERR "Can't read $f?\n"; 405 } 406 } 407 408 header("page-footer"); 409} 410 411sub showonly { 412 my ($f) = @_; 413 if(single($f, 1)) { 414 print STDERR "$f: failed\n"; 415 } 416} 417 418sub showprotocols { 419 my %prots; 420 foreach my $f (keys %optlong) { 421 my @p = split(/ /, $protolong{$f}); 422 for my $p (@p) { 423 $prots{$p}++; 424 } 425 } 426 for(sort keys %prots) { 427 printf "$_ (%d options)\n", $prots{$_}; 428 } 429} 430 431sub getargs { 432 my ($f, @s) = @_; 433 if($f eq "mainpage") { 434 mainpage(@s); 435 return; 436 } 437 elsif($f eq "listhelp") { 438 listhelp(); 439 return; 440 } 441 elsif($f eq "single") { 442 showonly($s[0]); 443 return; 444 } 445 elsif($f eq "protos") { 446 showprotocols(); 447 return; 448 } 449 elsif($f eq "listcats") { 450 listcats(); 451 return; 452 } 453 454 print "Usage: gen.pl <mainpage/listhelp/single FILE/protos/listcats> [files]\n"; 455} 456 457#------------------------------------------------------------------------ 458 459my $cmd = shift @ARGV; 460my @files = @ARGV; # the rest are the files 461 462# learn all existing options 463indexoptions(@files); 464 465getargs($cmd, @files); 466