lib/Pod/Man.pm

   1 # Pod::Man -- Convert POD data to formatted *roff input.
   2 # $Id: Man.pm,v 1.30 2001/11/28 01:14:28 eagle Exp $
   3 #
   4 # Copyright 1999, 2000, 2001 by Russ Allbery <rra@stanford.edu>
   5 #
   6 # This program is free software; you may redistribute it and/or modify it
   7 # under the same terms as Perl itself.
   8 #
   9 # This module translates POD documentation into *roff markup using the man
  10 # macro set, and is intended for converting POD documents written as Unix
  11 # manual pages to manual pages that can be read by the man(1) command.  It is
  12 # a replacement for the pod2man command distributed with versions of Perl
  13 # prior to 5.6.
  14 #
  15 # Perl core hackers, please note that this module is also separately
  16 # maintained outside of the Perl core as part of the podlators.  Please send
  17 # me any patches at the address above in addition to sending them to the
  18 # standard Perl mailing lists.
  19
  20 ##############################################################################
  21 # Modules and declarations
  22 ##############################################################################
  23
  24 package Pod::Man;
  25
  26 require 5.005;
  27
  28 use Carp qw(carp croak);
  29 use Pod::ParseLink qw(parselink);
  30 use Pod::Parser ();
  31
  32 use strict;
  33 use subs qw(makespace);
  34 use vars qw(@ISA %ESCAPES $PREAMBLE $VERSION);
  35
  36 @ISA = qw(Pod::Parser);
  37
  38 # Don't use the CVS revision as the version, since this module is also in Perl
  39 # core and too many things could munge CVS magic revision strings.  This
  40 # number should ideally be the same as the CVS revision in podlators, however.
  41 $VERSION = 1.30;
  42
  43
  44 ##############################################################################
  45 # Preamble and *roff output tables
  46 ##############################################################################
  47
  48 # The following is the static preamble which starts all *roff output we
  49 # generate.  It's completely static except for the font to use as a
  50 # fixed-width font, which is designed by @CFONT@, and the left and right
  51 # quotes to use for C<> text, designated by @LQOUTE@ and @RQUOTE@.  $PREAMBLE
  52 # should therefore be run through s/\@CFONT\@/<font>/g before output.
  53 $PREAMBLE = <<'----END OF PREAMBLE----';
  54 .de Sh \" Subsection heading
  55 .br
  56 .if t .Sp
  57 .ne 5
  58 .PP
  59 \fB\\$1\fR
  60 .PP
  61 ..
  62 .de Sp \" Vertical space (when we can't use .PP)
  63 .if t .sp .5v
  64 .if n .sp
  65 ..
  66 .de Vb \" Begin verbatim text
  67 .ft @CFONT@
  68 .nf
  69 .ne \\$1
  70 ..
  71 .de Ve \" End verbatim text
  72 .ft R
  73
  74 .fi
  75 ..
  76 .\" Set up some character translations and predefined strings.  \*(-- will
  77 .\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
  78 .\" double quote, and \*(R" will give a right double quote.  | will give a
  79 .\" real vertical bar.  \*(C+ will give a nicer C++.  Capital omega is used to
  80 .\" do unbreakable dashes and therefore won't be available.  \*(C` and \*(C'
  81 .\" expand to `' in nroff, nothing in troff, for use with C<>.
  82 .tr \(*W-|\(bv\*(Tr
  83 .ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
  84 .ie n \{\
  85 .    ds -- \(*W-
  86 .    ds PI pi
  87 .    if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
  88 .    if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\"  diablo 12 pitch
  89 .    ds L" ""
  90 .    ds R" ""
  91 .    ds C` @LQUOTE@
  92 .    ds C' @RQUOTE@
  93 'br\}
  94 .el\{\
  95 .    ds -- \|\(em\|
  96 .    ds PI \(*p
  97 .    ds L" ``
  98 .    ds R" ''
  99 'br\}
 100 .\"
 101 .\" If the F register is turned on, we'll generate index entries on stderr for
 102 .\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index
 103 .\" entries marked with X<> in POD.  Of course, you'll have to process the
 104 .\" output yourself in some meaningful fashion.
 105 .if \nF \{\
 106 .    de IX
 107 .    tm Index:\\$1\t\\n%\t"\\$2"
 108 ..
 109 .    nr % 0
 110 .    rr F
 111 .\}
 112 .\"
 113 .\" For nroff, turn off justification.  Always turn off hyphenation; it makes
 114 .\" way too many mistakes in technical documents.
 115 .hy 0
 116 .if n .na
 117 .\"
 118 .\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
 119 .\" Fear.  Run.  Save yourself.  No user-serviceable parts.
 120 .    \" fudge factors for nroff and troff
 121 .if n \{\
 122 .    ds #H 0
 123 .    ds #V .8m
 124 .    ds #F .3m
 125 .    ds #[ \f1
 126 .    ds #] \fP
 127 .\}
 128 .if t \{\
 129 .    ds #H ((1u-(\\\\n(.fu%2u))*.13m)
 130 .    ds #V .6m
 131 .    ds #F 0
 132 .    ds #[ \&
 133 .    ds #] \&
 134 .\}
 135 .    \" simple accents for nroff and troff
 136 .if n \{\
 137 .    ds ' \&
 138 .    ds ` \&
 139 .    ds ^ \&
 140 .    ds , \&
 141 .    ds ~ ~
 142 .    ds /
 143 .\}
 144 .if t \{\
 145 .    ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
 146 .    ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
 147 .    ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
 148 .    ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
 149 .    ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
 150 .    ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
 151 .\}
 152 .    \" troff and (daisy-wheel) nroff accents
 153 .ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
 154 .ds 8 \h'\*(#H'\(*b\h'-\*(#H'
 155 .ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
 156 .ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
 157 .ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
 158 .ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
 159 .ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
 160 .ds ae a\h'-(\w'a'u*4/10)'e
 161 .ds Ae A\h'-(\w'A'u*4/10)'E
 162 .    \" corrections for vroff
 163 .if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
 164 .if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
 165 .    \" for low resolution devices (crt and lpr)
 166 .if \n(.H>23 .if \n(.V>19 \
 167 \{\
 168 .    ds : e
 169 .    ds 8 ss
 170 .    ds o a
 171 .    ds d- d\h'-1'\(ga
 172 .    ds D- D\h'-1'\(hy
 173 .    ds th \o'bp'
 174 .    ds Th \o'LP'
 175 .    ds ae ae
 176 .    ds Ae AE
 177 .\}
 178 .rm #[ #] #H #V #F C
 179 ----END OF PREAMBLE----
 180 #`# for cperl-mode
 181
 182 # This table is taken nearly verbatim from Tom Christiansen's pod2man.  It
 183 # assumes that the standard preamble has already been printed, since that's
 184 # what defines all of the accent marks.  Note that some of these are quoted
 185 # with double quotes since they contain embedded single quotes, so use \\
 186 # uniformly for backslash for readability.
 187 %ESCAPES = (
 188     'amp'       =>    '&',      # ampersand
 189     'apos'      =>    "'",      # apostrophe
 190     'lt'        =>    '<',      # left chevron, less-than
 191     'gt'        =>    '>',      # right chevron, greater-than
 192     'quot'      =>    '"',      # double quote
 193     'sol'       =>    '/',      # solidus (forward slash)
 194     'verbar'    =>    '|',      # vertical bar
 195
 196     'Aacute'    =>    "A\\*'",  # capital A, acute accent
 197     'aacute'    =>    "a\\*'",  # small a, acute accent
 198     'Acirc'     =>    'A\\*^',  # capital A, circumflex accent
 199     'acirc'     =>    'a\\*^',  # small a, circumflex accent
 200     'AElig'     =>    '\*(AE',  # capital AE diphthong (ligature)
 201     'aelig'     =>    '\*(ae',  # small ae diphthong (ligature)
 202     'Agrave'    =>    "A\\*`",  # capital A, grave accent
 203     'agrave'    =>    "A\\*`",  # small a, grave accent
 204     'Aring'     =>    'A\\*o',  # capital A, ring
 205     'aring'     =>    'a\\*o',  # small a, ring
 206     'Atilde'    =>    'A\\*~',  # capital A, tilde
 207     'atilde'    =>    'a\\*~',  # small a, tilde
 208     'Auml'      =>    'A\\*:',  # capital A, dieresis or umlaut mark
 209     'auml'      =>    'a\\*:',  # small a, dieresis or umlaut mark
 210     'Ccedil'    =>    'C\\*,',  # capital C, cedilla
 211     'ccedil'    =>    'c\\*,',  # small c, cedilla
 212     'Eacute'    =>    "E\\*'",  # capital E, acute accent
 213     'eacute'    =>    "e\\*'",  # small e, acute accent
 214     'Ecirc'     =>    'E\\*^',  # capital E, circumflex accent
 215     'ecirc'     =>    'e\\*^',  # small e, circumflex accent
 216     'Egrave'    =>    'E\\*`',  # capital E, grave accent
 217     'egrave'    =>    'e\\*`',  # small e, grave accent
 218     'ETH'       =>    '\\*(D-', # capital Eth, Icelandic
 219     'eth'       =>    '\\*(d-', # small eth, Icelandic
 220     'Euml'      =>    'E\\*:',  # capital E, dieresis or umlaut mark
 221     'euml'      =>    'e\\*:',  # small e, dieresis or umlaut mark
 222     'Iacute'    =>    "I\\*'",  # capital I, acute accent
 223     'iacute'    =>    "i\\*'",  # small i, acute accent
 224     'Icirc'     =>    'I\\*^',  # capital I, circumflex accent
 225     'icirc'     =>    'i\\*^',  # small i, circumflex accent
 226     'Igrave'    =>    'I\\*`',  # capital I, grave accent
 227     'igrave'    =>    'i\\*`',  # small i, grave accent
 228     'Iuml'      =>    'I\\*:',  # capital I, dieresis or umlaut mark
 229     'iuml'      =>    'i\\*:',  # small i, dieresis or umlaut mark
 230     'Ntilde'    =>    'N\*~',   # capital N, tilde
 231     'ntilde'    =>    'n\*~',   # small n, tilde
 232     'Oacute'    =>    "O\\*'",  # capital O, acute accent
 233     'oacute'    =>    "o\\*'",  # small o, acute accent
 234     'Ocirc'     =>    'O\\*^',  # capital O, circumflex accent
 235     'ocirc'     =>    'o\\*^',  # small o, circumflex accent
 236     'Ograve'    =>    'O\\*`',  # capital O, grave accent
 237     'ograve'    =>    'o\\*`',  # small o, grave accent
 238     'Oslash'    =>    'O\\*/',  # capital O, slash
 239     'oslash'    =>    'o\\*/',  # small o, slash
 240     'Otilde'    =>    'O\\*~',  # capital O, tilde
 241     'otilde'    =>    'o\\*~',  # small o, tilde
 242     'Ouml'      =>    'O\\*:',  # capital O, dieresis or umlaut mark
 243     'ouml'      =>    'o\\*:',  # small o, dieresis or umlaut mark
 244     'szlig'     =>    '\*8',    # small sharp s, German (sz ligature)
 245     'THORN'     =>    '\\*(Th', # capital THORN, Icelandic
 246     'thorn'     =>    '\\*(th', # small thorn, Icelandic
 247     'Uacute'    =>    "U\\*'",  # capital U, acute accent
 248     'uacute'    =>    "u\\*'",  # small u, acute accent
 249     'Ucirc'     =>    'U\\*^',  # capital U, circumflex accent
 250     'ucirc'     =>    'u\\*^',  # small u, circumflex accent
 251     'Ugrave'    =>    'U\\*`',  # capital U, grave accent
 252     'ugrave'    =>    'u\\*`',  # small u, grave accent
 253     'Uuml'      =>    'U\\*:',  # capital U, dieresis or umlaut mark
 254     'uuml'      =>    'u\\*:',  # small u, dieresis or umlaut mark
 255     'Yacute'    =>    "Y\\*'",  # capital Y, acute accent
 256     'yacute'    =>    "y\\*'",  # small y, acute accent
 257     'yuml'      =>    'y\\*:',  # small y, dieresis or umlaut mark
 258
 259     'nbsp'      =>    '\\ ',    # non-breaking space
 260     'shy'       =>    '',       # soft (discretionary) hyphen
 261 );
 262
 263
 264 ##############################################################################
 265 # Static helper functions
 266 ##############################################################################
 267
 268 # Protect leading quotes and periods against interpretation as commands.  Also
 269 # protect anything starting with a backslash, since it could expand or hide
 270 # something that *roff would interpret as a command.  This is overkill, but
 271 # it's much simpler than trying to parse *roff here.
 272 sub protect {
 273     local $_ = shift;
 274     s/^([.\'\\])/\\&$1/mg;
 275     $_;
 276 }
 277
 278 # Translate a font string into an escape.
 279 sub toescape { (length ($_[0]) > 1 ? '\f(' : '\f') . $_[0] }
 280
 281
 282 ##############################################################################
 283 # Initialization
 284 ##############################################################################
 285
 286 # Initialize the object.  Here, we also process any additional options passed
 287 # to the constructor or set up defaults if none were given.  center is the
 288 # centered title, release is the version number, and date is the date for the
 289 # documentation.  Note that we can't know what file name we're processing due
 290 # to the architecture of Pod::Parser, so that *has* to either be passed to the
 291 # constructor or set separately with Pod::Man::name().
 292 sub initialize {
 293     my $self = shift;
 294
 295     # Figure out the fixed-width font.  If user-supplied, make sure that they
 296     # are the right length.
 297     for (qw/fixed fixedbold fixeditalic fixedbolditalic/) {
 298         if (defined $$self{$_}) {
 299             if (length ($$self{$_}) < 1 || length ($$self{$_}) > 2) {
 300                 croak qq(roff font should be 1 or 2 chars,)
 301                     . qq( not "$$self{$_}");
 302             }
 303         } else {
 304             $$self{$_} = '';
 305         }
 306     }
 307
 308     # Set the default fonts.  We can't be sure what fixed bold-italic is going
 309     # to be called, so default to just bold.
 310     $$self{fixed}           ||= 'CW';
 311     $$self{fixedbold}       ||= 'CB';
 312     $$self{fixeditalic}     ||= 'CI';
 313     $$self{fixedbolditalic} ||= 'CB';
 314
 315     # Set up a table of font escapes.  First number is fixed-width, second is
 316     # bold, third is italic.
 317     $$self{FONTS} = { '000' => '\fR', '001' => '\fI',
 318                       '010' => '\fB', '011' => '\f(BI',
 319                       '100' => toescape ($$self{fixed}),
 320                       '101' => toescape ($$self{fixeditalic}),
 321                       '110' => toescape ($$self{fixedbold}),
 322                       '111' => toescape ($$self{fixedbolditalic})};
 323
 324     # Extra stuff for page titles.
 325     $$self{center} = 'User Contributed Perl Documentation'
 326         unless defined $$self{center};
 327     $$self{indent} = 4 unless defined $$self{indent};
 328
 329     # We used to try first to get the version number from a local binary, but
 330     # we shouldn't need that any more.  Get the version from the running Perl.
 331     # Work a little magic to handle subversions correctly under both the
 332     # pre-5.6 and the post-5.6 version numbering schemes.
 333     if (!defined $$self{release}) {
 334         my @version = ($] =~ /^(\d+)\.(\d{3})(\d{0,3})$/);
 335         $version[2] ||= 0;
 336         $version[2] *= 10 ** (3 - length $version[2]);
 337         for (@version) { $_ += 0 }
 338         $$self{release} = 'perl v' . join ('.', @version);
 339     }
 340
 341     # Double quotes in things that will be quoted.
 342     for (qw/center date release/) {
 343         $$self{$_} =~ s/\"/\"\"/g if $$self{$_};
 344     }
 345
 346     # Figure out what quotes we'll be using for C<> text.
 347     $$self{quotes} ||= '"';
 348     if ($$self{quotes} eq 'none') {
 349         $$self{LQUOTE} = $$self{RQUOTE} = '';
 350     } elsif (length ($$self{quotes}) == 1) {
 351         $$self{LQUOTE} = $$self{RQUOTE} = $$self{quotes};
 352     } elsif ($$self{quotes} =~ /^(.)(.)$/
 353              || $$self{quotes} =~ /^(..)(..)$/) {
 354         $$self{LQUOTE} = $1;
 355         $$self{RQUOTE} = $2;
 356     } else {
 357         croak qq(Invalid quote specification "$$self{quotes}");
 358     }
 359
 360     # Double the first quote; note that this should not be s///g as two double
 361     # quotes is represented in *roff as three double quotes, not four.  Weird,
 362     # I know.
 363     $$self{LQUOTE} =~ s/\"/\"\"/;
 364     $$self{RQUOTE} =~ s/\"/\"\"/;
 365
 366     $self->SUPER::initialize;
 367 }
 368
 369 # For each document we process, output the preamble first.
 370 sub begin_pod {
 371     my $self = shift;
 372
 373     # Try to figure out the name and section from the file name.
 374     my $section = $$self{section} || 1;
 375     my $name = $$self{name};
 376     if (!defined $name) {
 377         $name = $self->input_file;
 378         $section = 3 if (!$$self{section} && $name =~ /\.pm\z/i);
 379         $name =~ s/\.p(od|[lm])\z//i;
 380         if ($section !~ /^3/) {
 381             require File::Basename;
 382             $name = uc File::Basename::basename ($name);
 383         } else {
 384             # Assume that we're dealing with a module.  We want to figure out
 385             # the full module name from the path to the file, but we don't
 386             # want to include too much of the path into the module name.  Lose
 387             # everything up to the first of:
 388             #
 389             #     */lib/*perl*/         standard or site_perl module
 390             #     */*perl*/lib/         from -Dprefix=/opt/perl
 391             #     */*perl*/             random module hierarchy
 392             #
 393             # which works.  Also strip off a leading site or site_perl
 394             # component, any OS-specific component, and any version number
 395             # component, and strip off an initial component of "lib" or
 396             # "blib/lib" since that's what ExtUtils::MakeMaker creates.
 397             # splitdir requires at least File::Spec 0.8.
 398             require File::Spec;
 399             my ($volume, $dirs, $file) = File::Spec->splitpath ($name);
 400             my @dirs = File::Spec->splitdir ($dirs);
 401             my $cut = 0;
 402             my $i;
 403             for ($i = 0; $i < scalar @dirs; $i++) {
 404                 if ($dirs[$i] eq 'lib' && $dirs[$i + 1] =~ /perl/) {
 405                     $cut = $i + 2;
 406                     last;
 407                 } elsif ($dirs[$i] =~ /perl/) {
 408                     $cut = $i + 1;
 409                     $cut++ if $dirs[$i + 1] eq 'lib';
 410                     last;
 411                 }
 412             }
 413             if ($cut > 0) {
 414                 splice (@dirs, 0, $cut);
 415                 shift @dirs if ($dirs[0] =~ /^site(_perl)?$/);
 416                 shift @dirs if ($dirs[0] =~ /^[\d.]+$/);
 417                 shift @dirs if ($dirs[0] =~ /^(.*-$^O|$^O-.*|$^O)$/);
 418             }
 419             shift @dirs if $dirs[0] eq 'lib';
 420             splice (@dirs, 0, 2) if ($dirs[0] eq 'blib' && $dirs[1] eq 'lib');
 421
 422             # Remove empty directories when building the module name; they
 423             # occur too easily on Unix by doubling slashes.
 424             $name = join ('::', (grep { $_ ? $_ : () } @dirs), $file);
 425         }
 426     }
 427
 428     # If $name contains spaces, quote it; this mostly comes up in the case of
 429     # input from stdin.
 430     $name = '"' . $name . '"' if ($name =~ /\s/);
 431
 432     # Modification date header.  Try to use the modification time of our
 433     # input.
 434     if (!defined $$self{date}) {
 435         my $time = (stat $self->input_file)[9] || time;
 436         my ($day, $month, $year) = (localtime $time)[3,4,5];
 437         $month++;
 438         $year += 1900;
 439         $$self{date} = sprintf ('%4d-%02d-%02d', $year, $month, $day);
 440     }
 441
 442     # Now, print out the preamble and the title.  The meaning of the arguments
 443     # to .TH unfortunately vary by system; some systems consider the fourth
 444     # argument to be a "source" and others use it as a version number.
 445     # Generally it's just presented as the left-side footer, though, so it
 446     # doesn't matter too much if a particular system gives it another
 447     # interpretation.
 448     #
 449     # The order of date and release used to be reversed in older versions of
 450     # this module, but this order is correct for both Solaris and Linux.
 451     local $_ = $PREAMBLE;
 452     s/\@CFONT\@/$$self{fixed}/;
 453     s/\@LQUOTE\@/$$self{LQUOTE}/;
 454     s/\@RQUOTE\@/$$self{RQUOTE}/;
 455     chomp $_;
 456     my $pversion = $Pod::Parser::VERSION;
 457     print { $self->output_handle } <<"----END OF HEADER----";
 458 .\\" Automatically generated by Pod::Man v$VERSION, Pod::Parser v$pversion
 459 .\\"
 460 .\\" Standard preamble:
 461 .\\" ========================================================================
 462 $_
 463 .\\" ========================================================================
 464 .\\"
 465 .IX Title "$name $section"
 466 .TH $name $section "$$self{date}" "$$self{release}" "$$self{center}"
 467 .UC
 468 ----END OF HEADER----
 469
 470     # Initialize a few per-file variables.
 471     $$self{INDENT}    = 0;      # Current indentation level.
 472     $$self{INDENTS}   = [];     # Stack of indentations.
 473     $$self{INDEX}     = [];     # Index keys waiting to be printed.
 474     $$self{ITEMS}     = 0;      # The number of consecutive =items.
 475     $$self{SHIFTWAIT} = 0;      # Whether there is a shift waiting.
 476     $$self{SHIFTS}    = [];     # Stack of .RS shifts.
 477 }
 478
 479
 480 ##############################################################################
 481 # Core overrides
 482 ##############################################################################
 483
 484 # Called for each command paragraph.  Gets the command, the associated
 485 # paragraph, the line number, and a Pod::Paragraph object.  Just dispatches
 486 # the command to a method named the same as the command.  =cut is handled
 487 # internally by Pod::Parser.
 488 sub command {
 489     my $self = shift;
 490     my $command = shift;
 491     return if $command eq 'pod';
 492     return if ($$self{EXCLUDE} && $command ne 'end');
 493     if ($self->can ('cmd_' . $command)) {
 494         $command = 'cmd_' . $command;
 495         $self->$command (@_);
 496     } else {
 497         my ($text, $line, $paragraph) = @_;
 498         my $file;
 499         ($file, $line) = $paragraph->file_line;
 500         $text =~ s/\n+\z//;
 501         $text = " $text" if ($text =~ /^\S/);
 502         warn qq($file:$line: Unknown command paragraph "=$command$text"\n);
 503         return;
 504     }
 505 }
 506
 507 # Called for a verbatim paragraph.  Gets the paragraph, the line number, and a
 508 # Pod::Paragraph object.  Rofficate backslashes, untabify, put a zero-width
 509 # character at the beginning of each line to protect against commands, and
 510 # wrap in .Vb/.Ve.
 511 sub verbatim {
 512     my $self = shift;
 513     return if $$self{EXCLUDE};
 514     local $_ = shift;
 515     return if /^\s+$/;
 516     s/\s+$/\n/;
 517     my $lines = tr/\n/\n/;
 518     1 while s/^(.*?)(\t+)/$1 . ' ' x (length ($2) * 8 - length ($1) % 8)/me;
 519     s/\\/\\e/g;
 520     s/^(\s*\S)/'\&' . $1/gme;
 521     $self->makespace;
 522     $self->output (".Vb $lines\n$_.Ve\n");
 523     $$self{NEEDSPACE} = 0;
 524 }
 525
 526 # Called for a regular text block.  Gets the paragraph, the line number, and a
 527 # Pod::Paragraph object.  Perform interpolation and output the results.
 528 sub textblock {
 529     my $self = shift;
 530     return if $$self{EXCLUDE};
 531     $self->output ($_[0]), return if $$self{VERBATIM};
 532
 533     # Parse the tree.  collapse knows about references to scalars as well as
 534     # scalars and does the right thing with them.  Tidy up any trailing
 535     # whitespace.
 536     my $text = shift;
 537     $text = $self->parse ($text, @_);
 538     $text =~ s/\n\s*$/\n/;
 539
 540     # Output the paragraph.  We also have to handle =over without =item.  If
 541     # there's an =over without =item, NEWINDENT will be set, and we need to
 542     # handle creation of the indent here.  Set WEIRDINDENT so that it will be
 543     # cleaned up on =back.
 544     $self->makespace;
 545     if ($$self{SHIFTWAIT}) {
 546         $self->output (".RS $$self{INDENT}\n");
 547         push (@{ $$self{SHIFTS} }, $$self{INDENT});
 548         $$self{SHIFTWAIT} = 0;
 549     }
 550     $self->output (protect $self->textmapfonts ($text));
 551     $self->outindex;
 552     $$self{NEEDSPACE} = 1;
 553 }
 554
 555 # Called for a formatting code.  Takes a Pod::InteriorSequence object and
 556 # returns a reference to a scalar.  This scalar is the final formatted text.
 557 # It's returned as a reference to an array so that other formatting codes
 558 # above us know that the text has already been processed.
 559 sub sequence {
 560     my ($self, $seq) = @_;
 561     my $command = $seq->cmd_name;
 562
 563     # We have to defer processing of the inside of an L<> formatting code.  If
 564     # this code is nested inside an L<> code, return the literal raw text of
 565     # it.
 566     my $parent = $seq->nested;
 567     while (defined $parent) {
 568         return $seq->raw_text if ($parent->cmd_name eq 'L');
 569         $parent = $parent->nested;
 570     }
 571
 572     # Zero-width characters.
 573     return [ '\&' ] if ($command eq 'Z');
 574
 575     # C<>, L<>, X<>, and E<> don't apply guesswork to their contents.  C<>
 576     # needs some additional special handling.
 577     my $literal = ($command =~ /^[CELX]$/);
 578     local $_ = $self->collapse ($seq->parse_tree, $literal, $command eq 'C');
 579
 580     # Handle E<> escapes.  Numeric escapes that match one of the supported ISO
 581     # 8859-1 characters don't work at present.
 582     if ($command eq 'E') {
 583         if (/^\d+$/) {
 584             return [ chr ($_) ];
 585         } elsif (exists $ESCAPES{$_}) {
 586             return [ $ESCAPES{$_} ];
 587         } else {
 588             my ($file, $line) = $seq->file_line;
 589             warn "$file:$line: Unknown escape E<$_>\n";
 590             return [ "E<$_>" ];
 591         }
 592     }
 593
 594     # For all the other codes, empty content produces no output.
 595     return '' if $_ eq '';
 596
 597     # Handle simple formatting codes.
 598     if ($command eq 'B') {
 599         return [ '\f(BS' . $_ . '\f(BE' ];
 600     } elsif ($command eq 'F' || $command eq 'I') {
 601         return [ '\f(IS' . $_ . '\f(IE' ];
 602     } elsif ($command eq 'C') {
 603         return [ $self->quote_literal ($_) ];
 604     }
 605
 606     # Handle links.
 607     if ($command eq 'L') {
 608         my ($text, $type) = (parselink ($_))[1,4];
 609         return '' unless $text;
 610         my ($file, $line) = $seq->file_line;
 611         $text = $self->parse ($text, $line);
 612         $text = '<' . $text . '>' if $type eq 'url';
 613         return [ $text ];
 614     }
 615
 616     # Whitespace protection replaces whitespace with "\ ".
 617     if ($command eq 'S') {
 618         s/\s+/\\ /g;
 619         return [ $_ ];
 620     }
 621
 622     # Add an index entry to the list of ones waiting to be output.
 623     if ($command eq 'X') {
 624         push (@{ $$self{INDEX} }, $_);
 625         return '';
 626     }
 627
 628     # Anything else is unknown.
 629     my ($file, $line) = $seq->file_line;
 630     warn "$file:$line: Unknown formatting code $command<$_>\n";
 631 }
 632
 633
 634 ##############################################################################
 635 # Command paragraphs
 636 ##############################################################################
 637
 638 # All command paragraphs take the paragraph and the line number.
 639
 640 # First level heading.  We can't output .IX in the NAME section due to a bug
 641 # in some versions of catman, so don't output a .IX for that section.  .SH
 642 # already uses small caps, so remove \s1 and \s-1.
 643 sub cmd_head1 {
 644     my $self = shift;
 645     local $_ = $self->parse (@_);
 646     s/\s+$//;
 647     s/\\s-?\d//g;
 648     s/\s*\n\s*/ /g;
 649     if ($$self{ITEMS} > 1) {
 650         $$self{ITEMS} = 0;
 651         $self->output (".PD\n");
 652     }
 653     $self->output ($self->switchquotes ('.SH', $self->mapfonts ($_)));
 654     $self->outindex (($_ eq 'NAME') ? () : ('Header', $_));
 655     $$self{NEEDSPACE} = 0;
 656 }
 657
 658 # Second level heading.
 659 sub cmd_head2 {
 660     my $self = shift;
 661     local $_ = $self->parse (@_);
 662     s/\s+$//;
 663     s/\s*\n\s*/ /g;
 664     if ($$self{ITEMS} > 1) {
 665         $$self{ITEMS} = 0;
 666         $self->output (".PD\n");
 667     }
 668     $self->output ($self->switchquotes ('.Sh', $self->mapfonts ($_)));
 669     $self->outindex ('Subsection', $_);
 670     $$self{NEEDSPACE} = 0;
 671 }
 672
 673 # Third level heading.
 674 sub cmd_head3 {
 675     my $self = shift;
 676     local $_ = $self->parse (@_);
 677     s/\s+$//;
 678     s/\s*\n\s*/ /g;
 679     if ($$self{ITEMS} > 1) {
 680         $$self{ITEMS} = 0;
 681         $self->output (".PD\n");
 682     }
 683     $self->makespace;
 684     $self->output ($self->textmapfonts ('\f(IS' . $_ . '\f(IE') . "\n");
 685     $self->outindex ('Subsection', $_);
 686     $$self{NEEDSPACE} = 1;
 687 }
 688
 689 # Fourth level heading.
 690 sub cmd_head4 {
 691     my $self = shift;
 692     local $_ = $self->parse (@_);
 693     s/\s+$//;
 694     s/\s*\n\s*/ /g;
 695     if ($$self{ITEMS} > 1) {
 696         $$self{ITEMS} = 0;
 697         $self->output (".PD\n");
 698     }
 699     $self->makespace;
 700     $self->output ($self->textmapfonts ($_) . "\n");
 701     $self->outindex ('Subsection', $_);
 702     $$self{NEEDSPACE} = 1;
 703 }
 704
 705 # Start a list.  For indents after the first, wrap the outside indent in .RS
 706 # so that hanging paragraph tags will be correct.
 707 sub cmd_over {
 708     my $self = shift;
 709     local $_ = shift;
 710     unless (/^[-+]?\d+\s+$/) { $_ = $$self{indent} }
 711     if (@{ $$self{SHIFTS} } < @{ $$self{INDENTS} }) {
 712         $self->output (".RS $$self{INDENT}\n");
 713         push (@{ $$self{SHIFTS} }, $$self{INDENT});
 714     }
 715     push (@{ $$self{INDENTS} }, $$self{INDENT});
 716     $$self{INDENT} = ($_ + 0);
 717     $$self{SHIFTWAIT} = 1;
 718 }
 719
 720 # End a list.  If we've closed an embedded indent, we've mangled the hanging
 721 # paragraph indent, so temporarily replace it with .RS and set WEIRDINDENT.
 722 # We'll close that .RS at the next =back or =item.
 723 sub cmd_back {
 724     my $self = shift;
 725     $$self{INDENT} = pop @{ $$self{INDENTS} };
 726     unless (defined $$self{INDENT}) {
 727         my ($file, $line, $paragraph) = @_;
 728         ($file, $line) = $paragraph->file_line;
 729         warn "$file:$line: Unmatched =back\n";
 730         $$self{INDENT} = 0;
 731     }
 732     if (@{ $$self{SHIFTS} } > @{ $$self{INDENTS} }) {
 733         $self->output (".RE\n");
 734         pop @{ $$self{SHIFTS} };
 735     }
 736     if (@{ $$self{INDENTS} } > 0) {
 737         $self->output (".RE\n");
 738         $self->output (".RS $$self{INDENT}\n");
 739     }
 740     $$self{NEEDSPACE} = 1;
 741     $$self{SHIFTWAIT} = 0;
 742 }
 743
 744 # An individual list item.  Emit an index entry for anything that's
 745 # interesting, but don't emit index entries for things like bullets and
 746 # numbers.  rofficate bullets too while we're at it (so for nice output, use *
 747 # for your lists rather than o or . or - or some other thing).  Newlines in an
 748 # item title are turned into spaces since *roff can't handle them embedded.
 749 sub cmd_item {
 750     my $self = shift;
 751     local $_ = $self->parse (@_);
 752     s/\s+$//;
 753     s/\s*\n\s*/ /g;
 754     my $index;
 755     if (/\w/ && !/^\w[.\)]\s*$/) {
 756         $index = $_;
 757         $index =~ s/^\s*[-*+o.]?(?:\s+|\Z)//;
 758     }
 759     $_ = '*' unless $_;
 760     s/^\*(\s|\Z)/\\\(bu$1/;
 761     if (@{ $$self{SHIFTS} } == @{ $$self{INDENTS} }) {
 762         $self->output (".RE\n");
 763         pop @{ $$self{SHIFTS} };
 764     }
 765     $_ = $self->textmapfonts ($_);
 766     $self->output (".PD 0\n") if ($$self{ITEMS} == 1);
 767     $self->output ($self->switchquotes ('.IP', $_, $$self{INDENT}));
 768     $self->outindex ($index ? ('Item', $index) : ());
 769     $$self{NEEDSPACE} = 0;
 770     $$self{ITEMS}++;
 771     $$self{SHIFTWAIT} = 0;
 772 }
 773
 774 # Begin a block for a particular translator.  Setting VERBATIM triggers
 775 # special handling in textblock().
 776 sub cmd_begin {
 777     my $self = shift;
 778     local $_ = shift;
 779     my ($kind) = /^(\S+)/ or return;
 780     if ($kind eq 'man' || $kind eq 'roff') {
 781         $$self{VERBATIM} = 1;
 782     } else {
 783         $$self{EXCLUDE} = 1;
 784     }
 785 }
 786
 787 # End a block for a particular translator.  We assume that all =begin/=end
 788 # pairs are properly closed.
 789 sub cmd_end {
 790     my $self = shift;
 791     $$self{EXCLUDE} = 0;
 792     $$self{VERBATIM} = 0;
 793 }
 794
 795 # One paragraph for a particular translator.  Ignore it unless it's intended
 796 # for man or roff, in which case we output it verbatim.
 797 sub cmd_for {
 798     my $self = shift;
 799     local $_ = shift;
 800     return unless s/^(?:man|roff)\b[ \t]*\n?//;
 801     $self->output ($_);
 802 }
 803
 804
 805 ##############################################################################
 806 # Escaping and fontification
 807 ##############################################################################
 808
 809 # At this point, we'll have embedded font codes of the form \f(<font>[SE]
 810 # where <font> is one of B, I, or F.  Turn those into the right font start or
 811 # end codes.  The old pod2man didn't get B<someI<thing> else> right; after I<>
 812 # it switched back to normal text rather than bold.  We take care of this by
 813 # using variables as a combined pointer to our current font sequence, and set
 814 # each to the number of current nestings of start tags for that font.  Use
 815 # them as a vector to look up what font sequence to use.
 816 #
 817 # \fP changes to the previous font, but only one previous font is kept.  We
 818 # don't know what the outside level font is; normally it's R, but if we're
 819 # inside a heading it could be something else.  So arrange things so that the
 820 # outside font is always the "previous" font and end with \fP instead of \fR.
 821 # Idea from Zack Weinberg.
 822 sub mapfonts {
 823     my $self = shift;
 824     local $_ = shift;
 825
 826     my ($fixed, $bold, $italic) = (0, 0, 0);
 827     my %magic = (F => \$fixed, B => \$bold, I => \$italic);
 828     my $last = '\fR';
 829     s { \\f\((.)(.) } {
 830         my $sequence = '';
 831         my $f;
 832         if ($last ne '\fR') { $sequence = '\fP' }
 833         ${ $magic{$1} } += ($2 eq 'S') ? 1 : -1;
 834         $f = $$self{FONTS}{($fixed && 1) . ($bold && 1) . ($italic && 1)};
 835         if ($f eq $last) {
 836             '';
 837         } else {
 838             if ($f ne '\fR') { $sequence .= $f }
 839             $last = $f;
 840             $sequence;
 841         }
 842     }gxe;
 843     $_;
 844 }
 845
 846 # Unfortunately, there is a bug in Solaris 2.6 nroff (not present in GNU
 847 # groff) where the sequence \fB\fP\f(CW\fP leaves the font set to B rather
 848 # than R, presumably because \f(CW doesn't actually do a font change.  To work
 849 # around this, use a separate textmapfonts for text blocks where the default
 850 # font is always R and only use the smart mapfonts for headings.
 851 sub textmapfonts {
 852     my $self = shift;
 853     local $_ = shift;
 854
 855     my ($fixed, $bold, $italic) = (0, 0, 0);
 856     my %magic = (F => \$fixed, B => \$bold, I => \$italic);
 857     s { \\f\((.)(.) } {
 858         ${ $magic{$1} } += ($2 eq 'S') ? 1 : -1;
 859         $$self{FONTS}{($fixed && 1) . ($bold && 1) . ($italic && 1)};
 860     }gxe;
 861     $_;
 862 }
 863
 864
 865 ##############################################################################
 866 # *roff-specific parsing and magic
 867 ##############################################################################
 868
 869 # Called instead of parse_text, calls parse_text with the right flags.
 870 sub parse {
 871     my $self = shift;
 872     $self->parse_text ({ -expand_seq   => 'sequence',
 873                          -expand_ptree => 'collapse' }, @_);
 874 }
 875
 876 # Takes a parse tree, a flag saying whether or not to treat it as literal text
 877 # (not call guesswork on it), and a flag saying whether or not to clean some
 878 # things up for *roff, and returns the concatenation of all of the text
 879 # strings in that parse tree.  If the literal flag isn't true, guesswork()
 880 # will be called on all plain scalars in the parse tree.  Otherwise, just
 881 # escape backslashes in the normal case.  If collapse is being called on a C<>
 882 # code, $cleanup should be set to true and some additional cleanup will be
 883 # done.  Assumes that everything in the parse tree is either a scalar or a
 884 # reference to a scalar.
 885 sub collapse {
 886     my ($self, $ptree, $literal, $cleanup) = @_;
 887     return join ('', map {
 888         if (ref $_) {
 889             join ('', @$_);
 890         } elsif ($literal) {
 891             if ($cleanup) {
 892                 s/\\/\\e/g;
 893                 s/-/\\-/g;
 894                 s/__/_\\|_/g;
 895             }
 896             $_;
 897         } else {
 898             $self->guesswork ($_);
 899         }
 900     } $ptree->children);
 901 }
 902
 903 # Takes a text block to perform guesswork on; this is guaranteed not to
 904 # contain any formatting codes.  Returns the text block with remapping done.
 905 sub guesswork {
 906     my $self = shift;
 907     local $_ = shift;
 908
 909     # rofficate backslashes.
 910     s/\\/\\e/g;
 911
 912     # Ensure double underbars have a tiny space between them.
 913     s/__/_\\|_/g;
 914
 915     # Leave hyphens only if they're part of regular words and there is only
 916     # one dash at a time.  Leave a dash after the first character as a regular
 917     # non-breaking dash, but don't let it mark the rest of the word invalid
 918     # for hyphenation.
 919     s/-/\\-/g;
 920     s{
 921       ( (?:\G|^|\s) [a-zA-Z] ) ( \\- )?
 922       ( (?: [a-zA-Z]+ \\-)+ )
 923       ( [a-zA-Z]+ ) (?=\s|\Z)
 924       \b
 925      } {
 926          my ($prefix, $hyphen, $main, $suffix) = ($1, $2, $3, $4);
 927          $hyphen ||= '';
 928          $main =~ s/\\-/-/g;
 929          $prefix . $hyphen . $main . $suffix;
 930     }egx;
 931
 932     # Translate -- into a real em dash if it's used like one.
 933     s{ (\s) \\-\\- (\s) }                         { $1 . '\*(--' . $2 }egx;
 934     s{ (\b[a-zA-Z]+) \\-\\- (\s|\Z|[a-zA-Z]+\b) } { $1 . '\*(--' . $2 }egx;
 935
 936     # Make all caps a little smaller.  Be careful here, since we don't want to
 937     # make @ARGV into small caps, nor do we want to fix the MIME in
 938     # MIME-Version, since it looks weird with the full-height V.
 939     s{
 940         ( ^ | [\s\(\"\'\`\[\{<>] )
 941         ( [A-Z] [A-Z] (?: [/A-Z+:\d_\$&] | \\- )* )
 942         (?= [\s>\}\]\(\)\'\".?!,;] | \\*\(-- | $ )
 943     } { $1 . '\s-1' . $2 . '\s0' }egx;
 944
 945     # Italize functions in the form func().
 946     s{
 947         ( \b | \\s-1 )
 948         (
 949             [A-Za-z_] ([:\w]|\\s-?[01])+ \(\)
 950         )
 951     } { $1 . '\f(IS' . $2 . '\f(IE' }egx;
 952
 953     # func(n) is a reference to a manual page.  Make it \fIfunc\fR\|(n).
 954     s{
 955         ( \b | \\s-1 )
 956         ( [A-Za-z_] (?:[.:\w]|\\-|\\s-?[01])+ )
 957         (
 958             \( \d [a-z]* \)
 959         )
 960     } { $1 . '\f(IS' . $2 . '\f(IE\|' . $3 }egx;
 961
 962     # Convert simple Perl variable references to a fixed-width font.
 963     s{
 964         ( \s+ )
 965         ( [\$\@%] [\w:]+ )
 966         (?! \( )
 967     } { $1 . '\f(FS' . $2 . '\f(FE'}egx;
 968
 969     # Fix up double quotes.
 970     s{ \" ([^\"]+) \" } { '\*(L"' . $1 . '\*(R"' }egx;
 971
 972     # Make C++ into \*(C+, which is a squinched version.
 973     s{ \b C\+\+ } {\\*\(C+}gx;
 974
 975     # All done.
 976     $_;
 977 }
 978
 979 # Handles C<> text, deciding whether to put \*C` around it or not.  This is a
 980 # whole bunch of messy heuristics to try to avoid overquoting, originally from
 981 # Barrie Slaymaker.  This largely duplicates similar code in Pod::Text.
 982 sub quote_literal {
 983     my $self = shift;
 984     local $_ = shift;
 985
 986     # A regex that matches the portion of a variable reference that's the
 987     # array or hash index, separated out just because we want to use it in
 988     # several places in the following regex.
 989     my $index = '(?: \[.*\] | \{.*\} )?';
 990
 991     # Check for things that we don't want to quote, and if we find any of
 992     # them, return the string with just a font change and no quoting.
 993     m{
 994       ^\s*
 995       (?:
 996          ( [\'\`\"] ) .* \1                             # already quoted
 997        | \` .* \'                                       # `quoted'
 998        | \$+ [\#^]? \S $index                           # special ($^Foo, $")
 999        | [\$\@%&*]+ \#? [:\'\w]+ $index                 # plain var or func
1000        | [\$\@%&*]* [:\'\w]+ (?: -> )? \(\s*[^\s,]\s*\) # 0/1-arg func call
1001        | [+-]? [\d.]+ (?: [eE] [+-]? \d+ )?             # a number
1002        | 0x [a-fA-F\d]+                                 # a hex constant
1003       )
1004       \s*\z
1005      }xo && return '\f(FS' . $_ . '\f(FE';
1006
1007     # If we didn't return, go ahead and quote the text.
1008     return '\f(FS\*(C`' . $_ . "\\*(C'\\f(FE";
1009 }
1010
1011
1012 ##############################################################################
1013 # Output formatting
1014 ##############################################################################
1015
1016 # Make vertical whitespace.
1017 sub makespace {
1018     my $self = shift;
1019     $self->output (".PD\n") if ($$self{ITEMS} > 1);
1020     $$self{ITEMS} = 0;
1021     $self->output ($$self{INDENT} > 0 ? ".Sp\n" : ".PP\n")
1022         if $$self{NEEDSPACE};
1023 }
1024
1025 # Output any pending index entries, and optionally an index entry given as an
1026 # argument.  Support multiple index entries in X<> separated by slashes, and
1027 # strip special escapes from index entries.
1028 sub outindex {
1029     my ($self, $section, $index) = @_;
1030     my @entries = map { split m%\s*/\s*% } @{ $$self{INDEX} };
1031     return unless ($section || @entries);
1032     $$self{INDEX} = [];
1033     my @output;
1034     if (@entries) {
1035         push (@output, [ 'Xref', join (' ', @entries) ]);
1036     }
1037     if ($section) {
1038         $index =~ s/\\-/-/g;
1039         $index =~ s/\\(?:s-?\d|.\(..|.)//g;
1040         push (@output, [ $section, $index ]);
1041     }
1042     for (@output) {
1043         my ($type, $entry) = @$_;
1044         $entry =~ s/\"/\"\"/g;
1045         $self->output (".IX $type " . '"' . $entry . '"' . "\n");
1046     }
1047 }
1048
1049 # Output text to the output device.
1050 sub output { print { $_[0]->output_handle } $_[1] }
1051
1052 # Given a command and a single argument that may or may not contain double
1053 # quotes, handle double-quote formatting for it.  If there are no double
1054 # quotes, just return the command followed by the argument in double quotes.
1055 # If there are double quotes, use an if statement to test for nroff, and for
1056 # nroff output the command followed by the argument in double quotes with
1057 # embedded double quotes doubled.  For other formatters, remap paired double
1058 # quotes to LQUOTE and RQUOTE.
1059 sub switchquotes {
1060     my $self = shift;
1061     my $command = shift;
1062     local $_ = shift;
1063     my $extra = shift;
1064     s/\\\*\([LR]\"/\"/g;
1065
1066     # We also have to deal with \*C` and \*C', which are used to add the
1067     # quotes around C<> text, since they may expand to " and if they do this
1068     # confuses the .SH macros and the like no end.  Expand them ourselves.
1069     # Also separate troff from nroff if there are any fixed-width fonts in use
1070     # to work around problems with Solaris nroff.
1071     my $c_is_quote = ($$self{LQUOTE} =~ /\"/) || ($$self{RQUOTE} =~ /\"/);
1072     my $fixedpat = join ('|', @{ $$self{FONTS} }{'100', '101', '110', '111'});
1073     $fixedpat =~ s/\\/\\\\/g;
1074     $fixedpat =~ s/\(/\\\(/g;
1075     if (/\"/ || /$fixedpat/) {
1076         s/\"/\"\"/g;
1077         my $nroff = $_;
1078         my $troff = $_;
1079         $troff =~ s/\"\"([^\"]*)\"\"/\`\`$1\'\'/g;
1080         if ($c_is_quote && /\\\*\(C[\'\`]/) {
1081             $nroff =~ s/\\\*\(C\`/$$self{LQUOTE}/g;
1082             $nroff =~ s/\\\*\(C\'/$$self{RQUOTE}/g;
1083             $troff =~ s/\\\*\(C[\'\`]//g;
1084         }
1085         $nroff = qq("$nroff") . ($extra ? " $extra" : '');
1086         $troff = qq("$troff") . ($extra ? " $extra" : '');
1087
1088         # Work around the Solaris nroff bug where \f(CW\fP leaves the font set
1089         # to Roman rather than the actual previous font when used in headings.
1090         # troff output may still be broken, but at least we can fix nroff by
1091         # just switching the font changes to the non-fixed versions.
1092         $nroff =~ s/\Q$$self{FONTS}{100}\E(.*)\\f[PR]/$1/g;
1093         $nroff =~ s/\Q$$self{FONTS}{101}\E(.*)\\f([PR])/\\fI$1\\f$2/g;
1094         $nroff =~ s/\Q$$self{FONTS}{110}\E(.*)\\f([PR])/\\fB$1\\f$2/g;
1095         $nroff =~ s/\Q$$self{FONTS}{111}\E(.*)\\f([PR])/\\f\(BI$1\\f$2/g;
1096
1097         # Now finally output the command.  Only bother with .ie if the nroff
1098         # and troff output isn't the same.
1099         if ($nroff ne $troff) {
1100             return ".ie n $command $nroff\n.el $command $troff\n";
1101         } else {
1102             return "$command $nroff\n";
1103         }
1104     } else {
1105         $_ = qq("$_") . ($extra ? " $extra" : '');
1106         return "$command $_\n";
1107     }
1108 }
1109
1110 __END__
1111
1112 ##############################################################################
1113 # Documentation
1114 ##############################################################################
1115
1116 =head1 NAME
1117
1118 Pod::Man - Convert POD data to formatted *roff input
1119
1120 =head1 SYNOPSIS
1121
1122     use Pod::Man;
1123     my $parser = Pod::Man->new (release => $VERSION, section => 8);
1124
1125     # Read POD from STDIN and write to STDOUT.
1126     $parser->parse_from_filehandle;
1127
1128     # Read POD from file.pod and write to file.1.
1129     $parser->parse_from_file ('file.pod', 'file.1');
1130
1131 =head1 DESCRIPTION
1132
1133 Pod::Man is a module to convert documentation in the POD format (the
1134 preferred language for documenting Perl) into *roff input using the man
1135 macro set.  The resulting *roff code is suitable for display on a terminal
1136 using L<nroff(1)>, normally via L<man(1)>, or printing using L<troff(1)>.
1137 It is conventionally invoked using the driver script B<pod2man>, but it can
1138 also be used directly.
1139
1140 As a derived class from Pod::Parser, Pod::Man supports the same methods and
1141 interfaces.  See L<Pod::Parser> for all the details; briefly, one creates a
1142 new parser with C<< Pod::Man->new() >> and then calls either
1143 parse_from_filehandle() or parse_from_file().
1144
1145 new() can take options, in the form of key/value pairs that control the
1146 behavior of the parser.  See below for details.
1147
1148 If no options are given, Pod::Man uses the name of the input file with any
1149 trailing C<.pod>, C<.pm>, or C<.pl> stripped as the man page title, to
1150 section 1 unless the file ended in C<.pm> in which case it defaults to
1151 section 3, to a centered title of "User Contributed Perl Documentation", to
1152 a centered footer of the Perl version it is run with, and to a left-hand
1153 footer of the modification date of its input (or the current date if given
1154 STDIN for input).
1155
1156 Pod::Man assumes that your *roff formatters have a fixed-width font named
1157 CW.  If yours is called something else (like CR), use the C<fixed> option to
1158 specify it.  This generally only matters for troff output for printing.
1159 Similarly, you can set the fonts used for bold, italic, and bold italic
1160 fixed-width output.
1161
1162 Besides the obvious pod conversions, Pod::Man also takes care of formatting
1163 func(), func(3), and simple variable references like $foo or @bar so you
1164 don't have to use code escapes for them; complex expressions like
1165 C<$fred{'stuff'}> will still need to be escaped, though.  It also translates
1166 dashes that aren't used as hyphens into en dashes, makes long dashes--like
1167 this--into proper em dashes, fixes "paired quotes," makes C++ look right,
1168 puts a little space between double underbars, makes ALLCAPS a teeny bit
1169 smaller in B<troff>, and escapes stuff that *roff treats as special so that
1170 you don't have to.
1171
1172 The recognized options to new() are as follows.  All options take a single
1173 argument.
1174
1175 =over 4
1176
1177 =item center
1178
1179 Sets the centered page header to use instead of "User Contributed Perl
1180 Documentation".
1181
1182 =item date
1183
1184 Sets the left-hand footer.  By default, the modification date of the input
1185 file will be used, or the current date if stat() can't find that file (the
1186 case if the input is from STDIN), and the date will be formatted as
1187 YYYY-MM-DD.
1188
1189 =item fixed
1190
1191 The fixed-width font to use for vertabim text and code.  Defaults to CW.
1192 Some systems may want CR instead.  Only matters for B<troff> output.
1193
1194 =item fixedbold
1195
1196 Bold version of the fixed-width font.  Defaults to CB.  Only matters for
1197 B<troff> output.
1198
1199 =item fixeditalic
1200
1201 Italic version of the fixed-width font (actually, something of a misnomer,
1202 since most fixed-width fonts only have an oblique version, not an italic
1203 version).  Defaults to CI.  Only matters for B<troff> output.
1204
1205 =item fixedbolditalic
1206
1207 Bold italic (probably actually oblique) version of the fixed-width font.
1208 Pod::Man doesn't assume you have this, and defaults to CB.  Some systems
1209 (such as Solaris) have this font available as CX.  Only matters for B<troff>
1210 output.
1211
1212 =item name
1213
1214 Set the name of the manual page.  Without this option, the manual name is
1215 set to the uppercased base name of the file being converted unless the
1216 manual section is 3, in which case the path is parsed to see if it is a Perl
1217 module path.  If it is, a path like C<.../lib/Pod/Man.pm> is converted into
1218 a name like C<Pod::Man>.  This option, if given, overrides any automatic
1219 determination of the name.
1220
1221 =item quotes
1222
1223 Sets the quote marks used to surround CE<lt>> text.  If the value is a
1224 single character, it is used as both the left and right quote; if it is two
1225 characters, the first character is used as the left quote and the second as
1226 the right quoted; and if it is four characters, the first two are used as
1227 the left quote and the second two as the right quote.
1228
1229 This may also be set to the special value C<none>, in which case no quote
1230 marks are added around CE<lt>> text (but the font is still changed for troff
1231 output).
1232
1233 =item release
1234
1235 Set the centered footer.  By default, this is the version of Perl you run
1236 Pod::Man under.  Note that some system an macro sets assume that the
1237 centered footer will be a modification date and will prepend something like
1238 "Last modified: "; if this is the case, you may want to set C<release> to
1239 the last modified date and C<date> to the version number.
1240
1241 =item section
1242
1243 Set the section for the C<.TH> macro.  The standard section numbering
1244 convention is to use 1 for user commands, 2 for system calls, 3 for
1245 functions, 4 for devices, 5 for file formats, 6 for games, 7 for
1246 miscellaneous information, and 8 for administrator commands.  There is a lot
1247 of variation here, however; some systems (like Solaris) use 4 for file
1248 formats, 5 for miscellaneous information, and 7 for devices.  Still others
1249 use 1m instead of 8, or some mix of both.  About the only section numbers
1250 that are reliably consistent are 1, 2, and 3.
1251
1252 By default, section 1 will be used unless the file ends in .pm in which case
1253 section 3 will be selected.
1254
1255 =back
1256
1257 The standard Pod::Parser method parse_from_filehandle() takes up to two
1258 arguments, the first being the file handle to read POD from and the second
1259 being the file handle to write the formatted output to.  The first defaults
1260 to STDIN if not given, and the second defaults to STDOUT.  The method
1261 parse_from_file() is almost identical, except that its two arguments are the
1262 input and output disk files instead.  See L<Pod::Parser> for the specific
1263 details.
1264
1265 =head1 DIAGNOSTICS
1266
1267 =over 4
1268
1269 =item roff font should be 1 or 2 chars, not "%s"
1270
1271 (F) You specified a *roff font (using C<fixed>, C<fixedbold>, etc.) that
1272 wasn't either one or two characters.  Pod::Man doesn't support *roff fonts
1273 longer than two characters, although some *roff extensions do (the canonical
1274 versions of B<nroff> and B<troff> don't either).
1275
1276 =item Invalid link %s
1277
1278 (W) The POD source contained a C<LE<lt>E<gt>> formatting code that
1279 Pod::Man was unable to parse.  You should never see this error message; it
1280 probably indicates a bug in Pod::Man.
1281
1282 =item Invalid quote specification "%s"
1283
1284 (F) The quote specification given (the quotes option to the constructor) was
1285 invalid.  A quote specification must be one, two, or four characters long.
1286
1287 =item %s:%d: Unknown command paragraph "%s".
1288
1289 (W) The POD source contained a non-standard command paragraph (something of
1290 the form C<=command args>) that Pod::Man didn't know about.  It was ignored.
1291
1292 =item %s:%d: Unknown escape EE<lt>%sE<gt>
1293
1294 (W) The POD source contained an C<EE<lt>E<gt>> escape that Pod::Man didn't
1295 know about.  C<EE<lt>%sE<gt>> was printed verbatim in the output.
1296
1297 =item %s:%d: Unknown formatting code %s
1298
1299 (W) The POD source contained a non-standard formatting code (something of
1300 the form C<XE<lt>E<gt>>) that Pod::Man didn't know about.  It was ignored.
1301
1302 =item %s:%d: Unmatched =back
1303
1304 (W) Pod::Man encountered a C<=back> command that didn't correspond to an
1305 C<=over> command.
1306
1307 =back
1308
1309 =head1 BUGS
1310
1311 Eight-bit input data isn't handled at all well at present.  The correct
1312 approach would be to map EE<lt>E<gt> escapes to the appropriate UTF-8
1313 characters and then do a translation pass on the output according to the
1314 user-specified output character set.  Unfortunately, we can't send eight-bit
1315 data directly to the output unless the user says this is okay, since some
1316 vendor *roff implementations can't handle eight-bit data.  If the *roff
1317 implementation can, however, that's far superior to the current hacked
1318 characters that only work under troff.
1319
1320 There is currently no way to turn off the guesswork that tries to format
1321 unmarked text appropriately, and sometimes it isn't wanted (particularly
1322 when using POD to document something other than Perl).
1323
1324 The NAME section should be recognized specially and index entries emitted
1325 for everything in that section.  This would have to be deferred until the
1326 next section, since extraneous things in NAME tends to confuse various man
1327 page processors.
1328
1329 Pod::Man doesn't handle font names longer than two characters.  Neither do
1330 most B<troff> implementations, but GNU troff does as an extension.  It would
1331 be nice to support as an option for those who want to use it.
1332
1333 The preamble added to each output file is rather verbose, and most of it is
1334 only necessary in the presence of EE<lt>E<gt> escapes for non-ASCII
1335 characters.  It would ideally be nice if all of those definitions were only
1336 output if needed, perhaps on the fly as the characters are used.
1337
1338 Pod::Man is excessively slow.
1339
1340 =head1 CAVEATS
1341
1342 The handling of hyphens and em dashes is somewhat fragile, and one may get
1343 the wrong one under some circumstances.  This should only matter for
1344 B<troff> output.
1345
1346 When and whether to use small caps is somewhat tricky, and Pod::Man doesn't
1347 necessarily get it right.
1348
1349 =head1 SEE ALSO
1350
1351 L<Pod::Parser>, L<perlpod(1)>, L<pod2man(1)>, L<nroff(1)>, L<troff(1)>,
1352 L<man(1)>, L<man(7)>
1353
1354 Ossanna, Joseph F., and Brian W. Kernighan.  "Troff User's Manual,"
1355 Computing Science Technical Report No. 54, AT&T Bell Laboratories.  This is
1356 the best documentation of standard B<nroff> and B<troff>.  At the time of
1357 this writing, it's available at
1358 L<http://www.cs.bell-labs.com/cm/cs/cstr.html>.
1359
1360 The man page documenting the man macro set may be L<man(5)> instead of
1361 L<man(7)> on your system.  Also, please see L<pod2man(1)> for extensive
1362 documentation on writing manual pages if you've not done it before and
1363 aren't familiar with the conventions.
1364
1365 =head1 AUTHOR
1366
1367 Russ Allbery <rra@stanford.edu>, based I<very> heavily on the original
1368 B<pod2man> by Tom Christiansen <tchrist@mox.perl.com>.
1369
1370 =head1 COPYRIGHT AND LICENSE
1371
1372 Copyright 1999, 2000, 2001 by Russ Allbery <rra@stanford.edu>.
1373
1374 This program is free software; you may redistribute it and/or modify it
1375 under the same terms as Perl itself.
1376
1377 =cut