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