1 1.1 christos #!/usr/bin/perl -w 2 1.1 christos 3 1.1 christos # Generate a short man page from --help and --version output. 4 1.1 christos # Copyright 1997, 1998, 1999, 2000 Free Software Foundation, Inc. 5 1.1 christos 6 1.1 christos # This program is free software; you can redistribute it and/or modify 7 1.1 christos # it under the terms of the GNU General Public License as published by 8 1.1 christos # the Free Software Foundation; either version 2, or (at your option) 9 1.1 christos # any later version. 10 1.1 christos 11 1.1 christos # This program is distributed in the hope that it will be useful, 12 1.1 christos # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 1.1 christos # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 1.1 christos # GNU General Public License for more details. 15 1.1 christos 16 1.1 christos # You should have received a copy of the GNU General Public License 17 1.1 christos # along with this program; if not, write to the Free Software Foundation, 18 1.1 christos # Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. 19 1.1 christos 20 1.1 christos # Written by Brendan O'Dea <bod (at] compusol.com.au> 21 1.1 christos # Available from ftp://ftp.gnu.org/gnu/help2man/ 22 1.1 christos 23 1.1 christos use 5.004; 24 1.1 christos use strict; 25 1.1 christos use Getopt::Long; 26 1.1 christos use Text::Tabs qw(expand); 27 1.1 christos use POSIX qw(strftime setlocale LC_TIME); 28 1.1 christos 29 1.1 christos my $this_program = 'help2man'; 30 1.1 christos my $this_version = '1.24'; 31 1.1 christos my $version_info = <<EOT; 32 1.1 christos GNU $this_program $this_version 33 1.1 christos 34 1.1 christos Copyright (C) 1997, 1998, 1999, 2000 Free Software Foundation, Inc. 35 1.1 christos This is free software; see the source for copying conditions. There is NO 36 1.1 christos warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 37 1.1 christos 38 1.1 christos Written by Brendan O'Dea <bod\@compusol.com.au> 39 1.1 christos EOT 40 1.1 christos 41 1.1 christos my $help_info = <<EOT; 42 1.1 christos `$this_program' generates a man page out of `--help' and `--version' output. 43 1.1 christos 44 1.1 christos Usage: $this_program [OPTION]... EXECUTABLE 45 1.1 christos 46 1.1 christos -n, --name=STRING use `STRING' as the description for the NAME paragraph 47 1.1 christos -s, --section=SECTION use `SECTION' as the section for the man page 48 1.1 christos -i, --include=FILE include material from `FILE' 49 1.1 christos -I, --opt-include=FILE include material from `FILE' if it exists 50 1.1 christos -o, --output=FILE send output to `FILE' 51 1.1 christos -N, --no-info suppress pointer to Texinfo manual 52 1.1 christos --help print this help, then exit 53 1.1 christos --version print version number, then exit 54 1.1 christos 55 1.1 christos EXECUTABLE should accept `--help' and `--version' options. 56 1.1 christos 57 1.1 christos Report bugs to <bug-help2man\@gnu.org>. 58 1.1 christos EOT 59 1.1 christos 60 1.1 christos my $section = 1; 61 1.1 christos my ($opt_name, @opt_include, $opt_output, $opt_no_info); 62 1.1 christos my %opt_def = ( 63 1.1 christos 'n|name=s' => \$opt_name, 64 1.1 christos 's|section=s' => \$section, 65 1.1 christos 'i|include=s' => sub { push @opt_include, [ pop, 1 ] }, 66 1.1 christos 'I|opt-include=s' => sub { push @opt_include, [ pop, 0 ] }, 67 1.1 christos 'o|output=s' => \$opt_output, 68 1.1 christos 'N|no-info' => \$opt_no_info, 69 1.1 christos ); 70 1.1 christos 71 1.1 christos # Parse options. 72 1.1 christos Getopt::Long::config('bundling'); 73 1.1 christos GetOptions (%opt_def, 74 1.1 christos help => sub { print $help_info; exit }, 75 1.1 christos version => sub { print $version_info; exit }, 76 1.1 christos ) or die $help_info; 77 1.1 christos 78 1.1 christos die $help_info unless @ARGV == 1; 79 1.1 christos 80 1.1 christos my %include = (); 81 1.1 christos my %append = (); 82 1.1 christos my @include = (); # retain order given in include file 83 1.1 christos 84 1.1 christos # Provide replacement `quote-regex' operator for pre-5.005. 85 1.1 christos BEGIN { eval q(sub qr { '' =~ $_[0]; $_[0] }) if $] < 5.005 } 86 1.1 christos 87 1.1 christos # Process include file (if given). Format is: 88 1.1 christos # 89 1.1 christos # [section name] 90 1.1 christos # verbatim text 91 1.1 christos # 92 1.1 christos # or 93 1.1 christos # 94 1.1 christos # /pattern/ 95 1.1 christos # verbatim text 96 1.1 christos # 97 1.1 christos 98 1.1 christos while (@opt_include) 99 1.1 christos { 100 1.1 christos my ($inc, $required) = @{shift @opt_include}; 101 1.1 christos 102 1.1 christos next unless -f $inc or $required; 103 1.1 christos die "$this_program: can't open `$inc' ($!)\n" 104 1.1 christos unless open INC, $inc; 105 1.1 christos 106 1.1 christos my $key; 107 1.1 christos my $hash = \%include; 108 1.1 christos 109 1.1 christos while (<INC>) 110 1.1 christos { 111 1.1 christos # [section] 112 1.1 christos if (/^\[([^]]+)\]/) 113 1.1 christos { 114 1.1 christos $key = uc $1; 115 1.1 christos $key =~ s/^\s+//; 116 1.1 christos $key =~ s/\s+$//; 117 1.1 christos $hash = \%include; 118 1.1 christos push @include, $key unless $include{$key}; 119 1.1 christos next; 120 1.1 christos } 121 1.1 christos 122 1.1 christos # /pattern/ 123 1.1 christos if (m!^/(.*)/([ims]*)!) 124 1.1 christos { 125 1.1 christos my $pat = $2 ? "(?$2)$1" : $1; 126 1.1 christos 127 1.1 christos # Check pattern. 128 1.1 christos eval { $key = qr($pat) }; 129 1.1 christos if ($@) 130 1.1 christos { 131 1.1 christos $@ =~ s/ at .*? line \d.*//; 132 1.1 christos die "$inc:$.:$@"; 133 1.1 christos } 134 1.1 christos 135 1.1 christos $hash = \%append; 136 1.1 christos next; 137 1.1 christos } 138 1.1 christos 139 1.1 christos # Check for options before the first section--anything else is 140 1.1 christos # silently ignored, allowing the first for comments and 141 1.1 christos # revision info. 142 1.1 christos unless ($key) 143 1.1 christos { 144 1.1 christos # handle options 145 1.1 christos if (/^-/) 146 1.1 christos { 147 1.1 christos local @ARGV = split; 148 1.1 christos GetOptions %opt_def; 149 1.1 christos } 150 1.1 christos 151 1.1 christos next; 152 1.1 christos } 153 1.1 christos 154 1.1 christos $hash->{$key} ||= ''; 155 1.1 christos $hash->{$key} .= $_; 156 1.1 christos } 157 1.1 christos 158 1.1 christos close INC; 159 1.1 christos 160 1.1 christos die "$this_program: no valid information found in `$inc'\n" 161 1.1 christos unless $key; 162 1.1 christos } 163 1.1 christos 164 1.1 christos # Compress trailing blank lines. 165 1.1 christos for my $hash (\(%include, %append)) 166 1.1 christos { 167 1.1 christos for (keys %$hash) { $hash->{$_} =~ s/\n+$/\n/ } 168 1.1 christos } 169 1.1 christos 170 1.1 christos # Turn off localisation of executable's ouput. 171 1.1 christos @ENV{qw(LANGUAGE LANG LC_ALL)} = ('C') x 3; 172 1.1 christos 173 1.1 christos # Turn off localisation of date (for strftime). 174 1.1 christos setlocale LC_TIME, 'C'; 175 1.1 christos 176 1.1 christos # Grab help and version info from executable. 177 1.1 christos my ($help_text, $version_text) = map { 178 1.1 christos join '', map { s/ +$//; expand $_ } `$ARGV[0] --$_ 2>/dev/null` 179 1.1 christos or die "$this_program: can't get `--$_' info from $ARGV[0]\n" 180 1.1 christos } qw(help version); 181 1.1 christos 182 1.1 christos my $date = strftime "%B %Y", localtime; 183 1.1 christos (my $program = $ARGV[0]) =~ s!.*/!!; 184 1.1 christos my $package = $program; 185 1.1 christos my $version; 186 1.1 christos 187 1.1 christos if ($opt_output) 188 1.1 christos { 189 1.1 christos unlink $opt_output 190 1.1 christos or die "$this_program: can't unlink $opt_output ($!)\n" 191 1.1 christos if -e $opt_output; 192 1.1 christos 193 1.1 christos open STDOUT, ">$opt_output" 194 1.1 christos or die "$this_program: can't create $opt_output ($!)\n"; 195 1.1 christos } 196 1.1 christos 197 1.1 christos # The first line of the --version information is assumed to be in one 198 1.1 christos # of the following formats: 199 1.1 christos # 200 1.1 christos # <version> 201 1.1 christos # <program> <version> 202 1.1 christos # {GNU,Free} <program> <version> 203 1.1 christos # <program> ({GNU,Free} <package>) <version> 204 1.1 christos # <program> - {GNU,Free} <package> <version> 205 1.1 christos # 206 1.1 christos # and seperated from any copyright/author details by a blank line. 207 1.1 christos 208 1.1 christos ($_, $version_text) = split /\n+/, $version_text, 2; 209 1.1 christos 210 1.1 christos if (/^(\S+) +\(((?:GNU|Free) +[^)]+)\) +(.*)/ or 211 1.1 christos /^(\S+) +- *((?:GNU|Free) +\S+) +(.*)/) 212 1.1 christos { 213 1.1 christos $program = $1; 214 1.1 christos $package = $2; 215 1.1 christos $version = $3; 216 1.1 christos } 217 1.1 christos elsif (/^((?:GNU|Free) +)?(\S+) +(.*)/) 218 1.1 christos { 219 1.1 christos $program = $2; 220 1.1 christos $package = $1 ? "$1$2" : $2; 221 1.1 christos $version = $3; 222 1.1 christos } 223 1.1 christos else 224 1.1 christos { 225 1.1 christos $version = $_; 226 1.1 christos } 227 1.1 christos 228 1.1 christos $program =~ s!.*/!!; 229 1.1 christos 230 1.1 christos # No info for `info' itself. 231 1.1 christos $opt_no_info = 1 if $program eq 'info'; 232 1.1 christos 233 1.1 christos # --name overrides --include contents. 234 1.1 christos $include{NAME} = "$program \\- $opt_name\n" if $opt_name; 235 1.1 christos 236 1.1 christos # Default (useless) NAME paragraph. 237 1.1 christos $include{NAME} ||= "$program \\- manual page for $program $version\n"; 238 1.1 christos 239 1.1 christos # Man pages traditionally have the page title in caps. 240 1.1 christos my $PROGRAM = uc $program; 241 1.1 christos 242 1.1 christos # Extract usage clause(s) [if any] for SYNOPSIS. 243 1.1 christos if ($help_text =~ s/^Usage:( +(\S+))(.*)((?:\n(?: {6}\1| *or: +\S).*)*)//m) 244 1.1 christos { 245 1.1 christos my @syn = $2 . $3; 246 1.1 christos 247 1.1 christos if ($_ = $4) 248 1.1 christos { 249 1.1 christos s/^\n//; 250 1.1 christos for (split /\n/) { s/^ *(or: +)?//; push @syn, $_ } 251 1.1 christos } 252 1.1 christos 253 1.1 christos my $synopsis = ''; 254 1.1 christos for (@syn) 255 1.1 christos { 256 1.1 christos $synopsis .= ".br\n" if $synopsis; 257 1.1 christos s!^\S*/!!; 258 1.1 christos s/^(\S+) *//; 259 1.1 christos $synopsis .= ".B $1\n"; 260 1.1 christos s/\s+$//; 261 1.1 christos s/(([][]|\.\.+)+)/\\fR$1\\fI/g; 262 1.1 christos s/^/\\fI/ unless s/^\\fR//; 263 1.1 christos $_ .= '\fR'; 264 1.1 christos s/(\\fI)( *)/$2$1/g; 265 1.1 christos s/\\fI\\fR//g; 266 1.1 christos s/^\\fR//; 267 1.1 christos s/\\fI$//; 268 1.1 christos s/^\./\\&./; 269 1.1 christos 270 1.1 christos $synopsis .= "$_\n"; 271 1.1 christos } 272 1.1 christos 273 1.1 christos $include{SYNOPSIS} ||= $synopsis; 274 1.1 christos } 275 1.1 christos 276 1.1 christos # Process text, initial section is DESCRIPTION. 277 1.1 christos my $sect = 'DESCRIPTION'; 278 1.1 christos $_ = "$help_text\n\n$version_text"; 279 1.1 christos 280 1.1 christos # Normalise paragraph breaks. 281 1.1 christos s/^\n+//; 282 1.1 christos s/\n*$/\n/; 283 1.1 christos s/\n\n+/\n\n/g; 284 1.1 christos 285 1.1 christos # Temporarily exchange leading dots, apostrophes and backslashes for 286 1.1 christos # tokens. 287 1.1 christos s/^\./\x80/mg; 288 1.1 christos s/^'/\x81/mg; 289 1.1 christos s/\\/\x82/g; 290 1.1 christos 291 1.1 christos # Start a new paragraph (if required) for these. 292 1.1 christos s/([^\n])\n(Report +bugs|Email +bug +reports +to|Written +by)/$1\n\n$2/g; 293 1.1 christos 294 1.1 christos sub convert_option; 295 1.1 christos 296 1.1 christos while (length) 297 1.1 christos { 298 1.1 christos # Convert some standard paragraph names. 299 1.1 christos if (s/^(Options|Examples): *\n//) 300 1.1 christos { 301 1.1 christos $sect = uc $1; 302 1.1 christos next; 303 1.1 christos } 304 1.1 christos 305 1.1 christos # Copyright section 306 1.1 christos if (/^Copyright +[(\xa9]/) 307 1.1 christos { 308 1.1 christos $sect = 'COPYRIGHT'; 309 1.1 christos $include{$sect} ||= ''; 310 1.1 christos $include{$sect} .= ".PP\n" if $include{$sect}; 311 1.1 christos 312 1.1 christos my $copy; 313 1.1 christos ($copy, $_) = split /\n\n/, $_, 2; 314 1.1 christos 315 1.1 christos for ($copy) 316 1.1 christos { 317 1.1 christos # Add back newline 318 1.1 christos s/\n*$/\n/; 319 1.1 christos 320 1.1 christos # Convert iso9959-1 copyright symbol or (c) to nroff 321 1.1 christos # character. 322 1.1 christos s/^Copyright +(?:\xa9|\([Cc]\))/Copyright \\(co/mg; 323 1.1 christos 324 1.1 christos # Insert line breaks before additional copyright messages 325 1.1 christos # and the disclaimer. 326 1.1 christos s/(.)\n(Copyright |This +is +free +software)/$1\n.br\n$2/g; 327 1.1 christos 328 1.1 christos # Join hyphenated lines. 329 1.1 christos s/([A-Za-z])-\n */$1/g; 330 1.1 christos } 331 1.1 christos 332 1.1 christos $include{$sect} .= $copy; 333 1.1 christos $_ ||= ''; 334 1.1 christos next; 335 1.1 christos } 336 1.1 christos 337 1.1 christos # Catch bug report text. 338 1.1 christos if (/^(Report +bugs|Email +bug +reports +to) /) 339 1.1 christos { 340 1.1 christos $sect = 'REPORTING BUGS'; 341 1.1 christos } 342 1.1 christos 343 1.1 christos # Author section. 344 1.1 christos elsif (/^Written +by/) 345 1.1 christos { 346 1.1 christos $sect = 'AUTHOR'; 347 1.1 christos } 348 1.1 christos 349 1.1 christos # Examples, indicated by an indented leading $, % or > are 350 1.1 christos # rendered in a constant width font. 351 1.1 christos if (/^( +)([\$\%>] )\S/) 352 1.1 christos { 353 1.1 christos my $indent = $1; 354 1.1 christos my $prefix = $2; 355 1.1 christos my $break = '.IP'; 356 1.1 christos $include{$sect} ||= ''; 357 1.1 christos while (s/^$indent\Q$prefix\E(\S.*)\n*//) 358 1.1 christos { 359 1.1 christos $include{$sect} .= "$break\n\\f(CW$prefix$1\\fR\n"; 360 1.1 christos $break = '.br'; 361 1.1 christos } 362 1.1 christos 363 1.1 christos next; 364 1.1 christos } 365 1.1 christos 366 1.1 christos my $matched = ''; 367 1.1 christos $include{$sect} ||= ''; 368 1.1 christos 369 1.1 christos # Sub-sections have a trailing colon and the second line indented. 370 1.1 christos if (s/^(\S.*:) *\n / /) 371 1.1 christos { 372 1.1 christos $matched .= $& if %append; 373 1.1 christos $include{$sect} .= qq(.SS "$1"\n); 374 1.1 christos } 375 1.1 christos 376 1.1 christos my $indent = 0; 377 1.1 christos my $content = ''; 378 1.1 christos 379 1.1 christos # Option with description. 380 1.1 christos if (s/^( {1,10}([+-]\S.*?))(?:( +)|\n( {20,}))(\S.*)\n//) 381 1.1 christos { 382 1.1 christos $matched .= $& if %append; 383 1.1 christos $indent = length ($4 || "$1$3"); 384 1.1 christos $content = ".TP\n\x83$2\n\x83$5\n"; 385 1.1 christos unless ($4) 386 1.1 christos { 387 1.1 christos # Indent may be different on second line. 388 1.1 christos $indent = length $& if /^ {20,}/; 389 1.1 christos } 390 1.1 christos } 391 1.1 christos 392 1.1 christos # Option without description. 393 1.1 christos elsif (s/^ {1,10}([+-]\S.*)\n//) 394 1.1 christos { 395 1.1 christos $matched .= $& if %append; 396 1.1 christos $content = ".HP\n\x83$1\n"; 397 1.1 christos $indent = 80; # not continued 398 1.1 christos } 399 1.1 christos 400 1.1 christos # Indented paragraph with tag. 401 1.1 christos elsif (s/^( +(\S.*?) +)(\S.*)\n//) 402 1.1 christos { 403 1.1 christos $matched .= $& if %append; 404 1.1 christos $indent = length $1; 405 1.1 christos $content = ".TP\n\x83$2\n\x83$3\n"; 406 1.1 christos } 407 1.1 christos 408 1.1 christos # Indented paragraph. 409 1.1 christos elsif (s/^( +)(\S.*)\n//) 410 1.1 christos { 411 1.1 christos $matched .= $& if %append; 412 1.1 christos $indent = length $1; 413 1.1 christos $content = ".IP\n\x83$2\n"; 414 1.1 christos } 415 1.1 christos 416 1.1 christos # Left justified paragraph. 417 1.1 christos else 418 1.1 christos { 419 1.1 christos s/(.*)\n//; 420 1.1 christos $matched .= $& if %append; 421 1.1 christos $content = ".PP\n" if $include{$sect}; 422 1.1 christos $content .= "$1\n"; 423 1.1 christos } 424 1.1 christos 425 1.1 christos # Append continuations. 426 1.1 christos while (s/^ {$indent}(\S.*)\n//) 427 1.1 christos { 428 1.1 christos $matched .= $& if %append; 429 1.1 christos $content .= "\x83$1\n" 430 1.1 christos } 431 1.1 christos 432 1.1 christos # Move to next paragraph. 433 1.1 christos s/^\n+//; 434 1.1 christos 435 1.1 christos for ($content) 436 1.1 christos { 437 1.1 christos # Leading dot and apostrophe protection. 438 1.1 christos s/\x83\./\x80/g; 439 1.1 christos s/\x83'/\x81/g; 440 1.1 christos s/\x83//g; 441 1.1 christos 442 1.1 christos # Convert options. 443 1.1 christos s/(^| )(-[][\w=-]+)/$1 . convert_option $2/mge; 444 1.1 christos } 445 1.1 christos 446 1.1 christos # Check if matched paragraph contains /pat/. 447 1.1 christos if (%append) 448 1.1 christos { 449 1.1 christos for my $pat (keys %append) 450 1.1 christos { 451 1.1 christos if ($matched =~ $pat) 452 1.1 christos { 453 1.1 christos $content .= ".PP\n" unless $append{$pat} =~ /^\./; 454 1.1 christos $content .= $append{$pat}; 455 1.1 christos } 456 1.1 christos } 457 1.1 christos } 458 1.1 christos 459 1.1 christos $include{$sect} .= $content; 460 1.1 christos } 461 1.1 christos 462 1.1 christos # Refer to the real documentation. 463 1.1 christos unless ($opt_no_info) 464 1.1 christos { 465 1.1 christos $sect = 'SEE ALSO'; 466 1.1 christos $include{$sect} ||= ''; 467 1.1 christos $include{$sect} .= ".PP\n" if $include{$sect}; 468 1.1 christos $include{$sect} .= <<EOT; 469 1.1 christos The full documentation for 470 1.1 christos .B $program 471 1.1 christos is maintained as a Texinfo manual. If the 472 1.1 christos .B info 473 1.1 christos and 474 1.1 christos .B $program 475 1.1 christos programs are properly installed at your site, the command 476 1.1 christos .IP 477 1.1 christos .B info $program 478 1.1 christos .PP 479 1.1 christos should give you access to the complete manual. 480 1.1 christos EOT 481 1.1 christos } 482 1.1 christos 483 1.1 christos # Output header. 484 1.1 christos print <<EOT; 485 1.1 christos .\\" DO NOT MODIFY THIS FILE! It was generated by $this_program $this_version. 486 1.1 christos .TH $PROGRAM "$section" "$date" "$package $version" GNU 487 1.1 christos EOT 488 1.1 christos 489 1.1 christos # Section ordering. 490 1.1 christos my @pre = qw(NAME SYNOPSIS DESCRIPTION OPTIONS EXAMPLES); 491 1.1 christos my @post = ('AUTHOR', 'REPORTING BUGS', 'COPYRIGHT', 'SEE ALSO'); 492 1.1 christos my $filter = join '|', @pre, @post; 493 1.1 christos 494 1.1 christos # Output content. 495 1.1 christos for (@pre, (grep ! /^($filter)$/o, @include), @post) 496 1.1 christos { 497 1.1 christos if ($include{$_}) 498 1.1 christos { 499 1.1 christos my $quote = /\W/ ? '"' : ''; 500 1.1 christos print ".SH $quote$_$quote\n"; 501 1.1 christos 502 1.1 christos for ($include{$_}) 503 1.1 christos { 504 1.1 christos # Replace leading dot, apostrophe and backslash tokens. 505 1.1 christos s/\x80/\\&./g; 506 1.1 christos s/\x81/\\&'/g; 507 1.1 christos s/\x82/\\e/g; 508 1.1 christos print; 509 1.1 christos } 510 1.1 christos } 511 1.1 christos } 512 1.1 christos 513 1.1 christos exit; 514 1.1 christos 515 1.1 christos # Convert option dashes to \- to stop nroff from hyphenating 'em, and 516 1.1 christos # embolden. Option arguments get italicised. 517 1.1 christos sub convert_option 518 1.1 christos { 519 1.1 christos local $_ = '\fB' . shift; 520 1.1 christos 521 1.1 christos s/-/\\-/g; 522 1.1 christos unless (s/\[=(.*)\]$/\\fR[=\\fI$1\\fR]/) 523 1.1 christos { 524 1.1 christos s/=(.)/\\fR=\\fI$1/; 525 1.1 christos s/ (.)/ \\fI$1/; 526 1.1 christos $_ .= '\fR'; 527 1.1 christos } 528 1.1 christos 529 1.1 christos $_; 530 1.1 christos } 531