pod/pod2man.PL

   1 #!/usr/local/bin/perl
   2
   3 use Config;
   4 use File::Basename qw(&basename &dirname);
   5
   6 # List explicitly here the variables you want Configure to
   7 # generate.  Metaconfig only looks for shell variables, so you
   8 # have to mention them as if they were shell variables, not
   9 # %Config entries.  Thus you write
  10 #  $startperl
  11 #  $man3ext
  12 # to ensure Configure will look for $Config{startperl}.
  13
  14 # This forces PL files to create target in same directory as PL file.
  15 # This is so that make depend always knows where to find PL derivatives.
  16 chdir dirname($0);
  17 $file = basename($0, '.PL');
  18 $file .= '.com' if $^O eq 'VMS';
  19
  20 open OUT,">$file" or die "Can't create $file: $!";
  21
  22 print "Extracting $file (with variable substitutions)\n";
  23
  24 # In this section, perl variables will be expanded during extraction.
  25 # You can use $Config{...} to use Configure variables.
  26
  27 print OUT <<"!GROK!THIS!";
  28 $Config{startperl}
  29     eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
  30         if \$running_under_some_shell;
  31
  32 \$DEF_PM_SECTION = '$Config{man3ext}' || '3';
  33 !GROK!THIS!
  34
  35 # In the following, perl variables are not expanded during extraction.
  36
  37 print OUT <<'!NO!SUBS!';
  38
  39 =head1 NAME
  40
  41 pod2man - translate embedded Perl pod directives into man pages
  42
  43 =head1 SYNOPSIS
  44
  45 B<pod2man>
  46 [ B<--section=>I<manext> ]
  47 [ B<--release=>I<relpatch> ]
  48 [ B<--center=>I<string> ]
  49 [ B<--date=>I<string> ]
  50 [ B<--fixed=>I<font> ]
  51 [ B<--official> ]
  52 [ B<--lax> ]
  53 I<inputfile>
  54
  55 =head1 DESCRIPTION
  56
  57 B<pod2man> converts its input file containing embedded pod directives (see
  58 L<perlpod>) into nroff source suitable for viewing with nroff(1) or
  59 troff(1) using the man(7) macro set.
  60
  61 Besides the obvious pod conversions, B<pod2man> also takes care of
  62 func(), func(n), and simple variable references like $foo or @bar so
  63 you don't have to use code escapes for them; complex expressions like
  64 C<$fred{'stuff'}> will still need to be escaped, though.  Other nagging
  65 little roffish things that it catches include translating the minus in
  66 something like foo-bar, making a long dash--like this--into a real em
  67 dash, fixing up "paired quotes", putting a little space after the
  68 parens in something like func(), making C++ and PI look right, making
  69 double underbars have a little tiny space between them, making ALLCAPS
  70 a teeny bit smaller in troff(1), and escaping backslashes so you don't
  71 have to.
  72
  73 =head1 OPTIONS
  74
  75 =over 8
  76
  77 =item center
  78
  79 Set the centered header to a specific string.  The default is
  80 "User Contributed Perl Documentation", unless the C<--official> flag is
  81 given, in which case the default is "Perl Programmers Reference Guide".
  82
  83 =item date
  84
  85 Set the left-hand footer string to this value.  By default,
  86 the modification date of the input file will be used.
  87
  88 =item fixed
  89
  90 The fixed font to use for code refs.  Defaults to CW.
  91
  92 =item official
  93
  94 Set the default header to indicate that this page is of
  95 the standard release in case C<--center> is not given.
  96
  97 =item release
  98
  99 Set the centered footer.  By default, this is the current
 100 perl release.
 101
 102 =item section
 103
 104 Set the section for the C<.TH> macro.  The standard conventions on
 105 sections are to use 1 for user commands,  2 for system calls, 3 for
 106 functions, 4 for devices, 5 for file formats, 6 for games, 7 for
 107 miscellaneous information, and 8 for administrator commands.  This works
 108 best if you put your Perl man pages in a separate tree, like
 109 F</usr/local/perl/man/>.  By default, section 1 will be used
 110 unless the file ends in F<.pm> in which case section 3 will be selected.
 111
 112 =item lax
 113
 114 Don't complain when required sections aren't present.
 115
 116 =back
 117
 118 =head1 Anatomy of a Proper Man Page
 119
 120 For those not sure of the proper layout of a man page, here's
 121 an example of the skeleton of a proper man page.  Head of the
 122 major headers should be setout as a C<=head1> directive, and
 123 are historically written in the rather startling ALL UPPER CASE
 124 format, although this is not mandatory.
 125 Minor headers may be included using C<=head2>, and are
 126 typically in mixed case.
 127
 128 =over 10
 129
 130 =item NAME
 131
 132 Mandatory section; should be a comma-separated list of programs or
 133 functions documented by this podpage, such as:
 134
 135     foo, bar - programs to do something
 136
 137 =item SYNOPSIS
 138
 139 A short usage summary for programs and functions, which
 140 may someday be deemed mandatory.
 141
 142 =item DESCRIPTION
 143
 144 Long drawn out discussion of the program.  It's a good idea to break this
 145 up into subsections using the C<=head2> directives, like
 146
 147     =head2 A Sample Subection
 148
 149     =head2 Yet Another Sample Subection
 150
 151 =item OPTIONS
 152
 153 Some people make this separate from the description.
 154
 155 =item RETURN VALUE
 156
 157 What the program or function returns if successful.
 158
 159 =item ERRORS
 160
 161 Exceptions, return codes, exit stati, and errno settings.
 162
 163 =item EXAMPLES
 164
 165 Give some example uses of the program.
 166
 167 =item ENVIRONMENT
 168
 169 Envariables this program might care about.
 170
 171 =item FILES
 172
 173 All files used by the program.  You should probably use the FE<lt>E<gt>
 174 for these.
 175
 176 =item SEE ALSO
 177
 178 Other man pages to check out, like man(1), man(7), makewhatis(8), or catman(8).
 179
 180 =item NOTES
 181
 182 Miscellaneous commentary.
 183
 184 =item CAVEATS
 185
 186 Things to take special care with; sometimes called WARNINGS.
 187
 188 =item DIAGNOSTICS
 189
 190 All possible messages the program can print out--and
 191 what they mean.
 192
 193 =item BUGS
 194
 195 Things that are broken or just don't work quite right.
 196
 197 =item RESTRICTIONS
 198
 199 Bugs you don't plan to fix :-)
 200
 201 =item AUTHOR
 202
 203 Who wrote it (or AUTHORS if multiple).
 204
 205 =item HISTORY
 206
 207 Programs derived from other sources sometimes have this, or
 208 you might keep a modification log here.
 209
 210 =back
 211
 212 =head1 EXAMPLES
 213
 214     pod2man program > program.1
 215     pod2man some_module.pm > /usr/perl/man/man3/some_module.3
 216     pod2man --section=7 note.pod > note.7
 217
 218 =head1 DIAGNOSTICS
 219
 220 The following diagnostics are generated by B<pod2man>.  Items
 221 marked "(W)" are non-fatal, whereas the "(F)" errors will cause
 222 B<pod2man> to immediately exit with a non-zero status.
 223
 224 =over 4
 225
 226 =item bad option in paragraph %d of %s: ``%s'' should be [%s]<%s>
 227
 228 (W) If you start include an option, you should set it off
 229 as bold, italic, or code.
 230
 231 =item can't open %s: %s
 232
 233 (F) The input file wasn't available for the given reason.
 234
 235 =item Improper man page - no dash in NAME header in paragraph %d of %s
 236
 237 (W) The NAME header did not have an isolated dash in it.  This is
 238 considered important.
 239
 240 =item Invalid man page - no NAME line in %s
 241
 242 (F) You did not include a NAME header, which is essential.
 243
 244 =item roff font should be 1 or 2 chars, not `%s'  (F)
 245
 246 (F) The font specified with the C<--fixed> option was not
 247 a one- or two-digit roff font.
 248
 249 =item %s is missing required section: %s
 250
 251 (W) Required sections include NAME, DESCRIPTION, and if you're
 252 using a section starting with a 3, also a SYNOPSIS.  Actually,
 253 not having a NAME is a fatal.
 254
 255 =item Unknown escape: %s in %s
 256
 257 (W) An unknown HTML entity (probably for an 8-bit character) was given via
 258 a C<EE<lt>E<gt>> directive.  Besides amp, lt, gt, and quot, recognized
 259 entities are Aacute, aacute, Acirc, acirc, AElig, aelig, Agrave, agrave,
 260 Aring, aring, Atilde, atilde, Auml, auml, Ccedil, ccedil, Eacute, eacute,
 261 Ecirc, ecirc, Egrave, egrave, ETH, eth, Euml, euml, Iacute, iacute, Icirc,
 262 icirc, Igrave, igrave, Iuml, iuml, Ntilde, ntilde, Oacute, oacute, Ocirc,
 263 ocirc, Ograve, ograve, Oslash, oslash, Otilde, otilde, Ouml, ouml, szlig,
 264 THORN, thorn, Uacute, uacute, Ucirc, ucirc, Ugrave, ugrave, Uuml, uuml,
 265 Yacute, yacute, and yuml.
 266
 267 =item Unmatched =back
 268
 269 (W) You have a C<=back> without a corresponding C<=over>.
 270
 271 =item Unrecognized pod directive: %s
 272
 273 (W) You specified a pod directive that isn't in the known list of
 274 C<=head1>, C<=head2>, C<=item>, C<=over>, C<=back>, or C<=cut>.
 275
 276
 277 =back
 278
 279 =head1 NOTES
 280
 281 If you would like to print out a lot of man page continuously, you
 282 probably want to set the C and D registers to set contiguous page
 283 numbering and even/odd paging, at least on some versions of man(7).
 284 Settting the F register will get you some additional experimental
 285 indexing:
 286
 287     troff -man -rC1 -rD1 -rF1 perl.1 perldata.1 perlsyn.1 ...
 288
 289 The indexing merely outputs messages via C<.tm> for each
 290 major page, section, subsection, item, and any C<XE<lt>E<gt>>
 291 directives.
 292
 293
 294 =head1 RESTRICTIONS
 295
 296 None at this time.
 297
 298 =head1 BUGS
 299
 300 The =over and =back directives don't really work right.  They
 301 take absolute positions instead of offsets, don't nest well, and
 302 making people count is suboptimal in any event.
 303
 304 =head1 AUTHORS
 305
 306 Original prototype by Larry Wall, but so massively hacked over by
 307 Tom Christiansen such that Larry probably doesn't recognize it anymore.
 308
 309 =cut
 310
 311 $/ = "";
 312 $cutting = 1;
 313
 314 # We try first to get the version number from a local binary, in case we're
 315 # running an installed version of Perl to produce documentation from an
 316 # uninstalled newer version's pod files.
 317 if ($^O ne 'plan9') {
 318   ($version,$patch) =
 319     `\PATH=.:..:\$PATH; perl -v` =~ /version (\d\.\d{3})(?:_(\d{2}))?/;
 320 }
 321 # No luck; we'll just go with the running Perl's version
 322 ($version,$patch) = $] =~ /^(.{5})(\d{2})?/ unless $version;
 323 $DEF_RELEASE  = "perl $version";
 324 $DEF_RELEASE .= ", patch $patch" if $patch;
 325
 326
 327 sub makedate {
 328     my $secs = shift;
 329     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($secs);
 330     my $mname = (qw{Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec})[$mon];
 331     return "$mday/$mname/$year";
 332 }
 333
 334 use Getopt::Long;
 335
 336 $DEF_SECTION = 1;
 337 $DEF_CENTER = "User Contributed Perl Documentation";
 338 $STD_CENTER = "Perl Programmers Reference Guide";
 339 $DEF_FIXED = 'CW';
 340 $DEF_LAX = 0;
 341
 342 sub usage {
 343     warn "$0: @_\n" if @_;
 344     die <<EOF;
 345 usage: $0 [options] podpage
 346 Options are:
 347         --section=manext      (default "$DEF_SECTION")
 348         --release=relpatch    (default "$DEF_RELEASE")
 349         --center=string       (default "$DEF_CENTER")
 350         --date=string         (default "$DEF_DATE")
 351         --fixed=font          (default "$DEF_FIXED")
 352         --official            (default NOT)
 353         --lax                 (default NOT)
 354 EOF
 355 }
 356
 357 $uok = GetOptions( qw(
 358         section=s
 359         release=s
 360         center=s
 361         date=s
 362         fixed=s
 363         official
 364         lax
 365         help));
 366
 367 $DEF_DATE = makedate((stat($ARGV[0]))[9] || time());
 368
 369 usage("Usage error!") unless $uok;
 370 usage() if $opt_help;
 371 usage("Need one and only one podpage argument") unless @ARGV == 1;
 372
 373 $section = $opt_section || ($ARGV[0] =~ /\.pm$/
 374                                 ? $DEF_PM_SECTION : $DEF_SECTION);
 375 $RP = $opt_release || $DEF_RELEASE;
 376 $center = $opt_center || ($opt_official ? $STD_CENTER : $DEF_CENTER);
 377 $lax = $opt_lax || $DEF_LAX;
 378
 379 $CFont = $opt_fixed || $DEF_FIXED;
 380
 381 if (length($CFont) == 2) {
 382     $CFont_embed = "\\f($CFont";
 383 }
 384 elsif (length($CFont) == 1) {
 385     $CFont_embed = "\\f$CFont";
 386 }
 387 else {
 388     die "roff font should be 1 or 2 chars, not `$CFont_embed'";
 389 }
 390
 391 $date = $opt_date || $DEF_DATE;
 392
 393 for (qw{NAME DESCRIPTION}) {
 394 # for (qw{NAME DESCRIPTION AUTHOR}) {
 395     $wanna_see{$_}++;
 396 }
 397 $wanna_see{SYNOPSIS}++ if $section =~ /^3/;
 398
 399
 400 $name = @ARGV ? $ARGV[0] : "<STDIN>";
 401 $Filename = $name;
 402 if ($section =~ /^1/) {
 403     require File::Basename;
 404     $name = uc File::Basename::basename($name);
 405 }
 406 $name =~ s/\.(pod|p[lm])$//i;
 407
 408 # Lose everything up to the first of
 409 #     */lib/*perl*      standard or site_perl module
 410 #     */*perl*/lib      from -D prefix=/opt/perl
 411 #     */*perl*/         random module hierarchy
 412 # which works.
 413 $name =~ s-//+-/-g;
 414 if ($name =~ s-^.*?/lib/[^/]*perl[^/]*/--i
 415         or $name =~ s-^.*?/[^/]*perl[^/]*/lib/--i
 416         or $name =~ s-^.*?/[^/]*perl[^/]*/--i) {
 417     # Lose ^arch/version/.
 418     $name =~ s-^[^/]+/\d+\.\d+/--;
 419 }
 420
 421 # Translate Getopt/Long to Getopt::Long, etc.
 422 $name =~ s(/)(::)g;
 423
 424 if ($name ne 'something') {
 425     FCHECK: {
 426         open(F, "< $ARGV[0]") || die "can't open $ARGV[0]: $!";
 427         while (<F>) {
 428             next unless /^=\b/;
 429             if (/^=head1\s+NAME\s*$/) {  # an /m would forgive mistakes
 430                 $_ = <F>;
 431                 unless (/\s*-+\s+/) {
 432                     $oops++;
 433                     warn "$0: Improper man page - no dash in NAME header in paragraph $. of $ARGV[0]\n"
 434                 } else {
 435                     my @n = split /\s+-+\s+/;
 436                     if (@n != 2) {
 437                         $oops++;
 438                         warn "$0: Improper man page - malformed NAME header in paragraph $. of $ARGV[0]\n"
 439                     }
 440                     else {
 441                         %namedesc = @n;
 442                     }
 443                 }
 444                 last FCHECK;
 445             }
 446             next if /^=cut\b/;  # DB_File and Net::Ping have =cut before NAME
 447             die "$0: Invalid man page - 1st pod line is not NAME in $ARGV[0]\n" unless $lax;
 448         }
 449         die "$0: Invalid man page - no documentation in $ARGV[0]\n" unless $lax;
 450     }
 451     close F;
 452 }
 453
 454 print <<"END";
 455 .rn '' }`
 456 ''' \$RCSfile\$\$Revision\$\$Date\$
 457 '''
 458 ''' \$Log\$
 459 '''
 460 .de Sh
 461 .br
 462 .if t .Sp
 463 .ne 5
 464 .PP
 465 \\fB\\\\\$1\\fR
 466 .PP
 467 ..
 468 .de Sp
 469 .if t .sp .5v
 470 .if n .sp
 471 ..
 472 .de Ip
 473 .br
 474 .ie \\\\n(.\$>=3 .ne \\\\\$3
 475 .el .ne 3
 476 .IP "\\\\\$1" \\\\\$2
 477 ..
 478 .de Vb
 479 .ft $CFont
 480 .nf
 481 .ne \\\\\$1
 482 ..
 483 .de Ve
 484 .ft R
 485
 486 .fi
 487 ..
 488 '''
 489 '''
 490 '''     Set up \\*(-- to give an unbreakable dash;
 491 '''     string Tr holds user defined translation string.
 492 '''     Bell System Logo is used as a dummy character.
 493 '''
 494 .tr \\(*W-|\\(bv\\*(Tr
 495 .ie n \\{\\
 496 .ds -- \\(*W-
 497 .ds PI pi
 498 .if (\\n(.H=4u)&(1m=24u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-12u'-\\" diablo 10 pitch
 499 .if (\\n(.H=4u)&(1m=20u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-8u'-\\" diablo 12 pitch
 500 .ds L" ""
 501 .ds R" ""
 502 .ds L' '
 503 .ds R' '
 504 'br\\}
 505 .el\\{\\
 506 .ds -- \\(em\\|
 507 .tr \\*(Tr
 508 .ds L" ``
 509 .ds R" ''
 510 .ds L' `
 511 .ds R' '
 512 .ds PI \\(*p
 513 'br\\}
 514 END
 515
 516 print <<'END';
 517 .\"     If the F register is turned on, we'll generate
 518 .\"     index entries out stderr for the following things:
 519 .\"             TH      Title
 520 .\"             SH      Header
 521 .\"             Sh      Subsection
 522 .\"             Ip      Item
 523 .\"             X<>     Xref  (embedded
 524 .\"     Of course, you have to process the output yourself
 525 .\"     in some meaninful fashion.
 526 .if \nF \{
 527 .de IX
 528 .tm Index:\\$1\t\\n%\t"\\$2"
 529 ..
 530 .nr % 0
 531 .rr F
 532 .\}
 533 END
 534
 535 print <<"END";
 536 .TH $name $section "$RP" "$date" "$center"
 537 .IX Title "$name $section"
 538 .UC
 539 END
 540
 541 while (($name, $desc) = each %namedesc) {
 542     for ($name, $desc) { s/^\s+//; s/\s+$//; }
 543     print qq(.IX Name "$name - $desc"\n);
 544 }
 545
 546 print <<'END';
 547 .if n .hy 0
 548 .if n .na
 549 .ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
 550 .de CQ          \" put $1 in typewriter font
 551 END
 552 print ".ft $CFont\n";
 553 print <<'END';
 554 'if n "\c
 555 'if t \\&\\$1\c
 556 'if n \\&\\$1\c
 557 'if n \&"
 558 \\&\\$2 \\$3 \\$4 \\$5 \\$6 \\$7
 559 '.ft R
 560 ..
 561 .\" @(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2
 562 .       \" AM - accent mark definitions
 563 .bd B 3
 564 .       \" fudge factors for nroff and troff
 565 .if n \{\
 566 .       ds #H 0
 567 .       ds #V .8m
 568 .       ds #F .3m
 569 .       ds #[ \f1
 570 .       ds #] \fP
 571 .\}
 572 .if t \{\
 573 .       ds #H ((1u-(\\\\n(.fu%2u))*.13m)
 574 .       ds #V .6m
 575 .       ds #F 0
 576 .       ds #[ \&
 577 .       ds #] \&
 578 .\}
 579 .       \" simple accents for nroff and troff
 580 .if n \{\
 581 .       ds ' \&
 582 .       ds ` \&
 583 .       ds ^ \&
 584 .       ds , \&
 585 .       ds ~ ~
 586 .       ds ? ?
 587 .       ds ! !
 588 .       ds /
 589 .       ds q
 590 .\}
 591 .if t \{\
 592 .       ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
 593 .       ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
 594 .       ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
 595 .       ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
 596 .       ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
 597 .       ds ? \s-2c\h'-\w'c'u*7/10'\u\h'\*(#H'\zi\d\s+2\h'\w'c'u*8/10'
 598 .       ds ! \s-2\(or\s+2\h'-\w'\(or'u'\v'-.8m'.\v'.8m'
 599 .       ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
 600 .       ds q o\h'-\w'o'u*8/10'\s-4\v'.4m'\z\(*i\v'-.4m'\s+4\h'\w'o'u*8/10'
 601 .\}
 602 .       \" troff and (daisy-wheel) nroff accents
 603 .ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
 604 .ds 8 \h'\*(#H'\(*b\h'-\*(#H'
 605 .ds v \\k:\h'-(\\n(.wu*9/10-\*(#H)'\v'-\*(#V'\*(#[\s-4v\s0\v'\*(#V'\h'|\\n:u'\*(#]
 606 .ds _ \\k:\h'-(\\n(.wu*9/10-\*(#H+(\*(#F*2/3))'\v'-.4m'\z\(hy\v'.4m'\h'|\\n:u'
 607 .ds . \\k:\h'-(\\n(.wu*8/10)'\v'\*(#V*4/10'\z.\v'-\*(#V*4/10'\h'|\\n:u'
 608 .ds 3 \*(#[\v'.2m'\s-2\&3\s0\v'-.2m'\*(#]
 609 .ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
 610 .ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
 611 .ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
 612 .ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
 613 .ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
 614 .ds ae a\h'-(\w'a'u*4/10)'e
 615 .ds Ae A\h'-(\w'A'u*4/10)'E
 616 .ds oe o\h'-(\w'o'u*4/10)'e
 617 .ds Oe O\h'-(\w'O'u*4/10)'E
 618 .       \" corrections for vroff
 619 .if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
 620 .if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
 621 .       \" for low resolution devices (crt and lpr)
 622 .if \n(.H>23 .if \n(.V>19 \
 623 \{\
 624 .       ds : e
 625 .       ds 8 ss
 626 .       ds v \h'-1'\o'\(aa\(ga'
 627 .       ds _ \h'-1'^
 628 .       ds . \h'-1'.
 629 .       ds 3 3
 630 .       ds o a
 631 .       ds d- d\h'-1'\(ga
 632 .       ds D- D\h'-1'\(hy
 633 .       ds th \o'bp'
 634 .       ds Th \o'LP'
 635 .       ds ae ae
 636 .       ds Ae AE
 637 .       ds oe oe
 638 .       ds Oe OE
 639 .\}
 640 .rm #[ #] #H #V #F C
 641 END
 642
 643 $indent = 0;
 644
 645 $begun = "";
 646
 647 while (<>) {
 648     if ($cutting) {
 649         next unless /^=/;
 650         $cutting = 0;
 651     }
 652     if ($begun) {
 653         if (/^=end\s+$begun/) {
 654             $begun = "";
 655         }
 656         elsif ($begun =~ /^(roff|man)$/) {
 657             print STDOUT $_;
 658         }
 659         next;
 660     }
 661     chomp;
 662
 663     # Translate verbatim paragraph
 664
 665     if (/^\s/) {
 666         @lines = split(/\n/);
 667         for (@lines) {
 668             1 while s
 669                 {^( [^\t]* ) \t ( \t* ) }
 670                 { $1 . ' ' x (8 - (length($1)%8) + 8 * (length($2))) }ex;
 671             s/\\/\\e/g;
 672             s/\A/\\&/s;
 673         }
 674         $lines = @lines;
 675         makespace() unless $verbatim++;
 676         print ".Vb $lines\n";
 677         print join("\n", @lines), "\n";
 678         print ".Ve\n";
 679         $needspace = 0;
 680         next;
 681     }
 682
 683     $verbatim = 0;
 684
 685     if (/^=for\s+(\S+)\s*/s) {
 686         if ($1 eq "man" or $1 eq "roff") {
 687             print STDOUT $',"\n\n";
 688         } else {
 689             # ignore unknown for
 690         }
 691         next;
 692     }
 693     elsif (/^=begin\s+(\S+)\s*/s) {
 694         $begun = $1;
 695         if ($1 eq "man" or $1 eq "roff") {
 696             print STDOUT $'."\n\n";
 697         }
 698         next;
 699     }
 700
 701     # check for things that'll hosed our noremap scheme; affects $_
 702     init_noremap();
 703
 704     if (!/^=item/) {
 705
 706         # trofficate backslashes; must do it before what happens below
 707         s/\\/noremap('\\e')/ge;
 708         # protect leading periods and quotes against *roff
 709         # mistaking them for directives
 710         s/^(?:[A-Z]<)?[.']/\\&$&/gm;
 711
 712         # first hide the escapes in case we need to
 713         # intuit something and get it wrong due to fmting
 714
 715         s/([A-Z]<[^<>]*>)/noremap($1)/ge;
 716
 717         # func() is a reference to a perl function
 718         s{
 719             \b
 720             (
 721                 [:\w]+ \(\)
 722             )
 723         } {I<$1>}gx;
 724
 725         # func(n) is a reference to a perl function or a man page
 726         s{
 727             ([:\w]+)
 728             (
 729                 \( [^\051]+ \)
 730             )
 731         } {I<$1>\\|$2}gx;
 732
 733         # convert simple variable references
 734         s/(\s+)([\$\@%][\w:]+)(?!\()/${1}C<$2>/g;
 735
 736         if (m{ (
 737                     [\-\w]+
 738                     \(
 739                         [^\051]*?
 740                         [\@\$,]
 741                         [^\051]*?
 742                     \)
 743                 )
 744             }x && $` !~ /([LCI]<[^<>]*|-)$/ && !/^=\w/)
 745         {
 746             warn "$0: bad option in paragraph $. of $ARGV: ``$1'' should be [LCI]<$1>\n";
 747             $oops++;
 748         }
 749
 750         while (/(-[a-zA-Z])\b/g && $` !~ /[\w\-]$/) {
 751             warn "$0: bad option in paragraph $. of $ARGV: ``$1'' should be [CB]<$1>\n";
 752             $oops++;
 753         }
 754
 755         # put it back so we get the <> processed again;
 756         clear_noremap(0); # 0 means leave the E's
 757
 758     } else {
 759         # trofficate backslashes
 760         s/\\/noremap('\\e')/ge;
 761
 762     }
 763
 764     # need to hide E<> first; they're processed in clear_noremap
 765     s/(E<[^<>]+>)/noremap($1)/ge;
 766
 767
 768     $maxnest = 10;
 769     while ($maxnest-- && /[A-Z]</) {
 770
 771         # can't do C font here
 772         s/([BI])<([^<>]*)>/font($1) . $2 . font('R')/eg;
 773
 774         # files and filelike refs in italics
 775         s/F<([^<>]*)>/I<$1>/g;
 776
 777         # no break -- usually we want C<> for this
 778         s/S<([^<>]*)>/nobreak($1)/eg;
 779
 780         # LREF: a manpage(3f)
 781         s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the I<$1>$2 manpage:g;
 782
 783         # LREF: an =item on another manpage
 784         s{
 785             L<
 786                 ([^/]+)
 787                 /
 788                 (
 789                     [:\w]+
 790                     (\(\))?
 791                 )
 792             >
 793         } {the C<$2> entry in the I<$1> manpage}gx;
 794
 795         # LREF: an =item on this manpage
 796         s{
 797            ((?:
 798             L<
 799                 /
 800                 (
 801                     [:\w]+
 802                     (\(\))?
 803                 )
 804             >
 805             (,?\s+(and\s+)?)?
 806           )+)
 807         } { internal_lrefs($1) }gex;
 808
 809         # LREF: a =head2 (head1?), maybe on a manpage, maybe right here
 810         # the "func" can disambiguate
 811         s{
 812             L<
 813                 (?:
 814                     ([a-zA-Z]\S+?) /
 815                 )?
 816                 "?(.*?)"?
 817             >
 818         }{
 819             do {
 820                 $1      # if no $1, assume it means on this page.
 821                     ?  "the section on I<$2> in the I<$1> manpage"
 822                     :  "the section on I<$2>"
 823             }
 824         }gesx; # s in case it goes over multiple lines, so . matches \n
 825
 826         s/Z<>/\\&/g;
 827
 828         # comes last because not subject to reprocessing
 829         s/C<([^<>]*)>/noremap("${CFont_embed}${1}\\fR")/eg;
 830     }
 831
 832     if (s/^=//) {
 833         $needspace = 0;         # Assume this.
 834
 835         s/\n/ /g;
 836
 837         ($Cmd, $_) = split(' ', $_, 2);
 838
 839         if (defined $_) {
 840             &escapes;
 841             s/"/""/g;
 842         }
 843
 844         clear_noremap(1);
 845
 846         if ($Cmd eq 'cut') {
 847             $cutting = 1;
 848         }
 849         elsif ($Cmd eq 'head1') {
 850             s/\s+$//;
 851             delete $wanna_see{$_} if exists $wanna_see{$_};
 852             print qq{.SH "$_"\n};
 853             print qq{.IX Header "$_"\n};
 854         }
 855         elsif ($Cmd eq 'head2') {
 856             print qq{.Sh "$_"\n};
 857             print qq{.IX Subsection "$_"\n};
 858         }
 859         elsif ($Cmd eq 'over') {
 860             push(@indent,$indent);
 861             $indent += ($_ + 0) || 5;
 862         }
 863         elsif ($Cmd eq 'back') {
 864             $indent = pop(@indent);
 865             warn "$0: Unmatched =back in paragraph $. of $ARGV\n" unless defined $indent;
 866             $needspace = 1;
 867         }
 868         elsif ($Cmd eq 'item') {
 869             s/^\*( |$)/\\(bu$1/g;
 870             # if you know how to get ":s please do
 871             s/\\\*\(L"([^"]+?)\\\*\(R"/'$1'/g;
 872             s/\\\*\(L"([^"]+?)""/'$1'/g;
 873             s/[^"]""([^"]+?)""[^"]/'$1'/g;
 874             # here do something about the $" in perlvar?
 875             print STDOUT qq{.Ip "$_" $indent\n};
 876             print qq{.IX Item "$_"\n};
 877         }
 878         elsif ($Cmd eq 'pod') {
 879             # this is just a comment
 880         }
 881         else {
 882             warn "$0: Unrecognized pod directive in paragraph $. of $ARGV: $Cmd\n";
 883         }
 884     }
 885     else {
 886         if ($needspace) {
 887             &makespace;
 888         }
 889         &escapes;
 890         clear_noremap(1);
 891         print $_, "\n";
 892         $needspace = 1;
 893     }
 894 }
 895
 896 print <<"END";
 897
 898 .rn }` ''
 899 END
 900
 901 if (%wanna_see && !$lax) {
 902     @missing = keys %wanna_see;
 903     warn "$0: $Filename is missing required section"
 904         .  (@missing > 1 && "s")
 905         .  ": @missing\n";
 906     $oops++;
 907 }
 908
 909 exit;
 910 #exit ($oops != 0);
 911
 912 #########################################################################
 913
 914 sub nobreak {
 915     my $string = shift;
 916     $string =~ s/ /\\ /g;
 917     $string;
 918 }
 919
 920 sub escapes {
 921
 922     s/X<(.*?)>/mkindex($1)/ge;
 923
 924     # translate the minus in foo-bar into foo\-bar for roff
 925     s/([^0-9a-z-])-([^-])/$1\\-$2/g;
 926
 927     # make -- into the string version \*(-- (defined above)
 928     s/\b--\b/\\*(--/g;
 929     s/"--([^"])/"\\*(--$1/g;  # should be a better way
 930     s/([^"])--"/$1\\*(--"/g;
 931
 932     # fix up quotes; this is somewhat tricky
 933     if (!/""/) {
 934         s/(^|\s)(['"])/noremap("$1\\*(L$2")/ge;
 935         s/(['"])($|[\-\s,;\\!?.])/noremap("\\*(R$1$2")/ge;
 936     }
 937
 938     #s/(?!")(?:.)--(?!")(?:.)/\\*(--/g;
 939     #s/(?:(?!")(?:.)--(?:"))|(?:(?:")--(?!")(?:.))/\\*(--/g;
 940
 941
 942     # make sure that func() keeps a bit a space tween the parens
 943     ### s/\b\(\)/\\|()/g;
 944     ### s/\b\(\)/(\\|)/g;
 945
 946     # make C++ into \*C+, which is a squinched version (defined above)
 947     s/\bC\+\+/\\*(C+/g;
 948
 949     # make double underbars have a little tiny space between them
 950     s/__/_\\|_/g;
 951
 952     # PI goes to \*(PI (defined above)
 953     s/\bPI\b/noremap('\\*(PI')/ge;
 954
 955     # make all caps a teeny bit smaller, but don't muck with embedded code literals
 956     my $hidCFont = font('C');
 957     if ($Cmd !~ /^head1/) { # SH already makes smaller
 958         # /g isn't enough; 1 while or we'll be off
 959
 960 #       1 while s{
 961 #           (?!$hidCFont)(..|^.|^)
 962 #           \b
 963 #           (
 964 #               [A-Z][\/A-Z+:\-\d_$.]+
 965 #           )
 966 #           (s?)
 967 #           \b
 968 #       } {$1\\s-1$2\\s0}gmox;
 969
 970         1 while s{
 971             (?!$hidCFont)(..|^.|^)
 972             (
 973                 \b[A-Z]{2,}[\/A-Z+:\-\d_\$]*\b
 974             )
 975         } {
 976             $1 . noremap( '\\s-1' .  $2 . '\\s0' )
 977         }egmox;
 978
 979     }
 980 }
 981
 982 # make troff just be normal, but make small nroff get quoted
 983 # decided to just put the quotes in the text; sigh;
 984 sub ccvt {
 985     local($_,$prev) = @_;
 986     noremap(qq{.CQ "$_" \n\\&});
 987 }
 988
 989 sub makespace {
 990     if ($indent) {
 991         print ".Sp\n";
 992     }
 993     else {
 994         print ".PP\n";
 995     }
 996 }
 997
 998 sub mkindex {
 999     my ($entry) = @_;
1000     my @entries = split m:\s*/\s*:, $entry;
1001     print ".IX Xref ";
1002     for $entry (@entries) {
1003         print qq("$entry" );
1004     }
1005     print "\n";
1006     return '';
1007 }
1008
1009 sub font {
1010     local($font) = shift;
1011     return '\\f' . noremap($font);
1012 }
1013
1014 sub noremap {
1015     local($thing_to_hide) = shift;
1016     $thing_to_hide =~ tr/\000-\177/\200-\377/;
1017     return $thing_to_hide;
1018 }
1019
1020 sub init_noremap {
1021         # escape high bit characters in input stream
1022         s/([\200-\377])/"E<".ord($1).">"/ge;
1023 }
1024
1025 sub clear_noremap {
1026     my $ready_to_print = $_[0];
1027
1028     tr/\200-\377/\000-\177/;
1029
1030     # trofficate backslashes
1031     # s/(?!\\e)(?:..|^.|^)\\/\\e/g;
1032
1033     # now for the E<>s, which have been hidden until now
1034     # otherwise the interative \w<> processing would have
1035     # been hosed by the E<gt>
1036     s {
1037             E<
1038             (
1039                 ( \d + )
1040                 | ( [A-Za-z]+ )
1041             )
1042             >
1043     } {
1044          do {
1045              defined $2
1046                 ? chr($2)
1047                 :
1048              exists $HTML_Escapes{$3}
1049                 ? do { $HTML_Escapes{$3} }
1050                 : do {
1051                     warn "$0: Unknown escape in paragraph $. of $ARGV: ``$&''\n";
1052                     "E<$1>";
1053                 }
1054          }
1055     }egx if $ready_to_print;
1056 }
1057
1058 sub internal_lrefs {
1059     local($_) = shift;
1060
1061     s{L</([^>]+)>}{$1}g;
1062     my(@items) = split( /(?:,?\s+(?:and\s+)?)/ );
1063     my $retstr = "the ";
1064     my $i;
1065     for ($i = 0; $i <= $#items; $i++) {
1066         $retstr .= "C<$items[$i]>";
1067         $retstr .= ", " if @items > 2 && $i != $#items;
1068         $retstr .= " and " if $i+2 == @items;
1069     }
1070
1071     $retstr .= " entr" . ( @items > 1  ? "ies" : "y" )
1072             .  " elsewhere in this document "; # terminal space to avoid words running together (pattern used strips terminal spaces)
1073
1074     return $retstr;
1075
1076 }
1077
1078 BEGIN {
1079 %HTML_Escapes = (
1080     'amp'       =>      '&',    #   ampersand
1081     'lt'        =>      '<',    #   left chevron, less-than
1082     'gt'        =>      '>',    #   right chevron, greater-than
1083     'quot'      =>      '"',    #   double quote
1084
1085     "Aacute"    =>      "A\\*'",        #   capital A, acute accent
1086     "aacute"    =>      "a\\*'",        #   small a, acute accent
1087     "Acirc"     =>      "A\\*^",        #   capital A, circumflex accent
1088     "acirc"     =>      "a\\*^",        #   small a, circumflex accent
1089     "AElig"     =>      '\*(AE',        #   capital AE diphthong (ligature)
1090     "aelig"     =>      '\*(ae',        #   small ae diphthong (ligature)
1091     "Agrave"    =>      "A\\*`",        #   capital A, grave accent
1092     "agrave"    =>      "A\\*`",        #   small a, grave accent
1093     "Aring"     =>      'A\\*o',        #   capital A, ring
1094     "aring"     =>      'a\\*o',        #   small a, ring
1095     "Atilde"    =>      'A\\*~',        #   capital A, tilde
1096     "atilde"    =>      'a\\*~',        #   small a, tilde
1097     "Auml"      =>      'A\\*:',        #   capital A, dieresis or umlaut mark
1098     "auml"      =>      'a\\*:',        #   small a, dieresis or umlaut mark
1099     "Ccedil"    =>      'C\\*,',        #   capital C, cedilla
1100     "ccedil"    =>      'c\\*,',        #   small c, cedilla
1101     "Eacute"    =>      "E\\*'",        #   capital E, acute accent
1102     "eacute"    =>      "e\\*'",        #   small e, acute accent
1103     "Ecirc"     =>      "E\\*^",        #   capital E, circumflex accent
1104     "ecirc"     =>      "e\\*^",        #   small e, circumflex accent
1105     "Egrave"    =>      "E\\*`",        #   capital E, grave accent
1106     "egrave"    =>      "e\\*`",        #   small e, grave accent
1107     "ETH"       =>      '\\*(D-',       #   capital Eth, Icelandic
1108     "eth"       =>      '\\*(d-',       #   small eth, Icelandic
1109     "Euml"      =>      "E\\*:",        #   capital E, dieresis or umlaut mark
1110     "euml"      =>      "e\\*:",        #   small e, dieresis or umlaut mark
1111     "Iacute"    =>      "I\\*'",        #   capital I, acute accent
1112     "iacute"    =>      "i\\*'",        #   small i, acute accent
1113     "Icirc"     =>      "I\\*^",        #   capital I, circumflex accent
1114     "icirc"     =>      "i\\*^",        #   small i, circumflex accent
1115     "Igrave"    =>      "I\\*`",        #   capital I, grave accent
1116     "igrave"    =>      "i\\*`",        #   small i, grave accent
1117     "Iuml"      =>      "I\\*:",        #   capital I, dieresis or umlaut mark
1118     "iuml"      =>      "i\\*:",        #   small i, dieresis or umlaut mark
1119     "Ntilde"    =>      'N\*~',         #   capital N, tilde
1120     "ntilde"    =>      'n\*~',         #   small n, tilde
1121     "Oacute"    =>      "O\\*'",        #   capital O, acute accent
1122     "oacute"    =>      "o\\*'",        #   small o, acute accent
1123     "Ocirc"     =>      "O\\*^",        #   capital O, circumflex accent
1124     "ocirc"     =>      "o\\*^",        #   small o, circumflex accent
1125     "Ograve"    =>      "O\\*`",        #   capital O, grave accent
1126     "ograve"    =>      "o\\*`",        #   small o, grave accent
1127     "Oslash"    =>      "O\\*/",        #   capital O, slash
1128     "oslash"    =>      "o\\*/",        #   small o, slash
1129     "Otilde"    =>      "O\\*~",        #   capital O, tilde
1130     "otilde"    =>      "o\\*~",        #   small o, tilde
1131     "Ouml"      =>      "O\\*:",        #   capital O, dieresis or umlaut mark
1132     "ouml"      =>      "o\\*:",        #   small o, dieresis or umlaut mark
1133     "szlig"     =>      '\*8',          #   small sharp s, German (sz ligature)
1134     "THORN"     =>      '\\*(Th',       #   capital THORN, Icelandic
1135     "thorn"     =>      '\\*(th',,      #   small thorn, Icelandic
1136     "Uacute"    =>      "U\\*'",        #   capital U, acute accent
1137     "uacute"    =>      "u\\*'",        #   small u, acute accent
1138     "Ucirc"     =>      "U\\*^",        #   capital U, circumflex accent
1139     "ucirc"     =>      "u\\*^",        #   small u, circumflex accent
1140     "Ugrave"    =>      "U\\*`",        #   capital U, grave accent
1141     "ugrave"    =>      "u\\*`",        #   small u, grave accent
1142     "Uuml"      =>      "U\\*:",        #   capital U, dieresis or umlaut mark
1143     "uuml"      =>      "u\\*:",        #   small u, dieresis or umlaut mark
1144     "Yacute"    =>      "Y\\*'",        #   capital Y, acute accent
1145     "yacute"    =>      "y\\*'",        #   small y, acute accent
1146     "yuml"      =>      "y\\*:",        #   small y, dieresis or umlaut mark
1147 );
1148 }
1149
1150 !NO!SUBS!
1151
1152 close OUT or die "Can't close $file: $!";
1153 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
1154 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';