1 #!/usr/bin/env perl 2 3 =begin comment 4 5 This script generates the manpage. 6 7 Example: gen.pl mainpage > curl.1 8 9 Dev notes: 10 11 We open *input* files in :crlf translation (a no-op on many platforms) in 12 case we have CRLF line endings in Windows but a perl that defaults to LF. 13 Unfortunately it seems some perls like msysgit can't handle a global input-only 14 :crlf so it has to be specified on each file open for text input. 15 16 =end comment 17 =cut 18 19 my $some_dir=$ARGV[1] || "."; 20 21 opendir(my $dh, $some_dir) || die "Can't opendir $some_dir: $!"; 22 my @s = grep { /\.d$/ && -f "$some_dir/$_" } readdir($dh); 23 closedir $dh; 24 25 my %optshort; 26 my %optlong; 27 my %helplong; 28 my %arglong; 29 my %redirlong; 30 my %protolong; 31 32 # get the long name version, return the man page string 33 sub manpageify { 34 my ($k)=@_; 35 my $l; 36 if($optlong{$k} ne "") { 37 # both short + long 38 $l = "\\fI-".$optlong{$k}.", --$k\\fP"; 39 } 40 else { 41 # only long 42 $l = "\\fI--$k\\fP"; 43 } 44 return $l; 45 } 46 47 sub printdesc { 48 my @desc = @_; 49 for my $d (@desc) { 50 # skip lines starting with space (examples) 51 if($d =~ /^[^ ]/) { 52 for my $k (keys %optlong) { 53 my $l = manpageify($k); 54 $d =~ s/--$k([^a-z0-9_-])/$l$1/; 55 } 56 } 57 print $d; 58 } 59 } 60 61 sub seealso { 62 my($standalone, $data)=@_; 63 if($standalone) { 64 return sprintf 65 ".SH \"SEE ALSO\"\n$data\n"; 66 } 67 else { 68 return "See also $data. "; 69 } 70 } 71 72 sub overrides { 73 my ($standalone, $data)=@_; 74 if($standalone) { 75 return ".SH \"OVERRIDES\"\n$data\n"; 76 } 77 else { 78 return $data; 79 } 80 } 81 82 sub protocols { 83 my ($standalone, $data)=@_; 84 if($standalone) { 85 return ".SH \"PROTOCOLS\"\n$data\n"; 86 } 87 else { 88 return "($data) "; 89 } 90 } 91 92 sub added { 93 my ($standalone, $data)=@_; 94 if($standalone) { 95 return ".SH \"ADDED\"\nAdded in curl version $data\n"; 96 } 97 else { 98 return "Added in $data. "; 99 } 100 } 101 102 sub single { 103 my ($f, $standalone)=@_; 104 open(F, "<:crlf", "$some_dir/$f") || 105 return 1; 106 my $short; 107 my $long; 108 my $tags; 109 my $added; 110 my $protocols; 111 my $arg; 112 my $mutexed; 113 my $requires; 114 my $seealso; 115 my $magic; # cmdline special option 116 while(<F>) { 117 if(/^Short: *(.)/i) { 118 $short=$1; 119 } 120 elsif(/^Long: *(.*)/i) { 121 $long=$1; 122 } 123 elsif(/^Added: *(.*)/i) { 124 $added=$1; 125 } 126 elsif(/^Tags: *(.*)/i) { 127 $tags=$1; 128 } 129 elsif(/^Arg: *(.*)/i) { 130 $arg=$1; 131 } 132 elsif(/^Magic: *(.*)/i) { 133 $magic=$1; 134 } 135 elsif(/^Mutexed: *(.*)/i) { 136 $mutexed=$1; 137 } 138 elsif(/^Protocols: *(.*)/i) { 139 $protocols=$1; 140 } 141 elsif(/^See-also: *(.*)/i) { 142 $seealso=$1; 143 } 144 elsif(/^Requires: *(.*)/i) { 145 $requires=$1; 146 } 147 elsif(/^Help: *(.*)/i) { 148 ; 149 } 150 elsif(/^---/) { 151 if(!$long) { 152 print STDERR "WARN: no 'Long:' in $f\n"; 153 } 154 last; 155 } 156 else { 157 chomp; 158 print STDERR "WARN: unrecognized line in $f, ignoring:\n:'$_';" 159 } 160 } 161 my @dest; 162 while(<F>) { 163 push @desc, $_; 164 } 165 close(F); 166 my $opt; 167 if(defined($short) && $long) { 168 $opt = "-$short, --$long"; 169 } 170 elsif($short && !$long) { 171 $opt = "-$short"; 172 } 173 elsif($long && !$short) { 174 $opt = "--$long"; 175 } 176 177 if($arg) { 178 $opt .= " $arg"; 179 } 180 181 if($standalone) { 182 print ".TH curl 1 \"30 Nov 2016\" \"curl 7.52.0\" \"curl manual\"\n"; 183 print ".SH OPTION\n"; 184 print "curl $opt\n"; 185 } 186 else { 187 print ".IP \"$opt\"\n"; 188 } 189 if($protocols) { 190 print protocols($standalone, $protocols); 191 } 192 193 if($standalone) { 194 print ".SH DESCRIPTION\n"; 195 } 196 197 printdesc(@desc); 198 undef @desc; 199 200 my @foot; 201 if($seealso) { 202 my @m=split(/ /, $seealso); 203 my $mstr; 204 for my $k (@m) { 205 my $l = manpageify($k); 206 $mstr .= sprintf "%s$l", $mstr?" and ":""; 207 } 208 push @foot, seealso($standalone, $mstr); 209 } 210 if($requires) { 211 my $l = manpageify($long); 212 push @foot, "$l requires that the underlying libcurl". 213 " was built to support $requires. "; 214 } 215 if($mutexed) { 216 my @m=split(/ /, $mutexed); 217 my $mstr; 218 for my $k (@m) { 219 my $l = manpageify($k); 220 $mstr .= sprintf "%s$l", $mstr?" and ":""; 221 } 222 push @foot, overrides($standalone, "This option overrides $mstr. "); 223 } 224 if($added) { 225 push @foot, added($standalone, $added); 226 } 227 if($foot[0]) { 228 print "\n"; 229 my $f = join("", @foot); 230 $f =~ s/ +\z//; # remove trailing space 231 print "$f\n"; 232 } 233 return 0; 234 } 235 236 sub getshortlong { 237 my ($f)=@_; 238 open(F, "<:crlf", "$some_dir/$f"); 239 my $short; 240 my $long; 241 my $help; 242 my $arg; 243 my $protocols; 244 while(<F>) { 245 if(/^Short: (.)/i) { 246 $short=$1; 247 } 248 elsif(/^Long: (.*)/i) { 249 $long=$1; 250 } 251 elsif(/^Help: (.*)/i) { 252 $help=$1; 253 } 254 elsif(/^Arg: (.*)/i) { 255 $arg=$1; 256 } 257 elsif(/^Protocols: (.*)/i) { 258 $protocols=$1; 259 } 260 elsif(/^---/) { 261 last; 262 } 263 } 264 close(F); 265 if($short) { 266 $optshort{$short}=$long; 267 } 268 if($long) { 269 $optlong{$long}=$short; 270 $helplong{$long}=$help; 271 $arglong{$long}=$arg; 272 $protolong{$long}=$protocols; 273 } 274 } 275 276 sub indexoptions { 277 foreach my $f (@s) { 278 getshortlong($f); 279 } 280 } 281 282 sub header { 283 my ($f)=@_; 284 open(F, "<:crlf", "$some_dir/$f"); 285 my @d; 286 while(<F>) { 287 push @d, $_; 288 } 289 close(F); 290 printdesc(@d); 291 } 292 293 sub listhelp { 294 foreach my $f (sort keys %helplong) { 295 my $long = $f; 296 my $short = $optlong{$long}; 297 my $opt; 298 299 if(defined($short) && $long) { 300 $opt = "-$short, --$long"; 301 } 302 elsif($long && !$short) { 303 $opt = " --$long"; 304 } 305 306 my $arg = $arglong{$long}; 307 if($arg) { 308 $opt .= " $arg"; 309 } 310 my $desc = $helplong{$f}; 311 $desc =~ s/\"/\\\"/g; # escape double quotes 312 313 my $line = sprintf " {\"%s\",\n \"%s\"},\n", $opt, $desc; 314 315 if(length($opt) + length($desc) > 78) { 316 print STDERR "WARN: the --$long line is too long\n"; 317 } 318 print $line; 319 } 320 } 321 322 sub mainpage { 323 # show the page header 324 header("page-header"); 325 326 # output docs for all options 327 foreach my $f (sort @s) { 328 single($f, 0); 329 } 330 331 header("page-footer"); 332 } 333 334 sub showonly { 335 my ($f) = @_; 336 if(single($f, 1)) { 337 print STDERR "$f: failed\n"; 338 } 339 } 340 341 sub showprotocols { 342 my %prots; 343 foreach my $f (keys %optlong) { 344 my @p = split(/ /, $protolong{$f}); 345 for my $p (@p) { 346 $prots{$p}++; 347 } 348 } 349 for(sort keys %prots) { 350 printf "$_ (%d options)\n", $prots{$_}; 351 } 352 } 353 354 sub getargs { 355 my $f; 356 do { 357 $f = shift @ARGV; 358 if($f eq "mainpage") { 359 mainpage(); 360 return; 361 } 362 elsif($f eq "listhelp") { 363 listhelp(); 364 return; 365 } 366 elsif($f eq "single") { 367 showonly(shift @ARGV); 368 return; 369 } 370 elsif($f eq "protos") { 371 showprotocols(); 372 return; 373 } 374 } while($f); 375 376 print "Usage: gen.pl <mainpage/listhelp/single FILE/protos> [srcdir]\n"; 377 } 378 379 #------------------------------------------------------------------------ 380 381 # learn all existing options 382 indexoptions(); 383 384 getargs(); 385 386
