xref: /openbsd-src/gnu/usr.bin/perl/cpan/podlators/lib/Pod/Man.pm (revision c90a81c56dcebd6a1b73fe4aff9b03385b8e63b3)
1# Pod::Man -- Convert POD data to formatted *roff input.
2#
3# This module translates POD documentation into *roff markup using the man
4# macro set, and is intended for converting POD documents written as Unix
5# manual pages to manual pages that can be read by the man(1) command.  It is
6# a replacement for the pod2man command distributed with versions of Perl
7# prior to 5.6.
8#
9# Perl core hackers, please note that this module is also separately
10# maintained outside of the Perl core as part of the podlators.  Please send
11# me any patches at the address above in addition to sending them to the
12# standard Perl mailing lists.
13#
14# Written by Russ Allbery <rra@cpan.org>
15# Substantial contributions by Sean Burke <sburke@cpan.org>
16# Copyright 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
17#     2010, 2012, 2013, 2014, 2015, 2016 Russ Allbery <rra@cpan.org>
18#
19# This program is free software; you may redistribute it and/or modify it
20# under the same terms as Perl itself.
21
22##############################################################################
23# Modules and declarations
24##############################################################################
25
26package Pod::Man;
27
28use 5.006;
29use strict;
30use warnings;
31
32use subs qw(makespace);
33use vars qw(@ISA %ESCAPES $PREAMBLE $VERSION);
34
35use Carp qw(carp croak);
36use Pod::Simple ();
37
38# Conditionally import Encode and set $HAS_ENCODE if it is available.
39our $HAS_ENCODE;
40BEGIN {
41    $HAS_ENCODE = eval { require Encode };
42}
43
44@ISA = qw(Pod::Simple);
45
46$VERSION = '4.07';
47
48# Set the debugging level.  If someone has inserted a debug function into this
49# class already, use that.  Otherwise, use any Pod::Simple debug function
50# that's defined, and failing that, define a debug level of 10.
51BEGIN {
52    my $parent = defined (&Pod::Simple::DEBUG) ? \&Pod::Simple::DEBUG : undef;
53    unless (defined &DEBUG) {
54        *DEBUG = $parent || sub () { 10 };
55    }
56}
57
58# Import the ASCII constant from Pod::Simple.  This is true iff we're in an
59# ASCII-based universe (including such things as ISO 8859-1 and UTF-8), and is
60# generally only false for EBCDIC.
61BEGIN { *ASCII = \&Pod::Simple::ASCII }
62
63# Pretty-print a data structure.  Only used for debugging.
64BEGIN { *pretty = \&Pod::Simple::pretty }
65
66# Formatting instructions for various types of blocks.  cleanup makes hyphens
67# hard, adds spaces between consecutive underscores, and escapes backslashes.
68# convert translates characters into escapes.  guesswork means to apply the
69# transformations done by the guesswork sub.  literal says to protect literal
70# quotes from being turned into UTF-8 quotes.  By default, all transformations
71# are on except literal, but some elements override.
72#
73# DEFAULT specifies the default settings.  All other elements should list only
74# those settings that they are overriding.  Data indicates =for roff blocks,
75# which should be passed along completely verbatim.
76#
77# Formatting inherits negatively, in the sense that if the parent has turned
78# off guesswork, all child elements should leave it off.
79my %FORMATTING = (
80    DEFAULT  => { cleanup => 1, convert => 1, guesswork => 1, literal => 0 },
81    Data     => { cleanup => 0, convert => 0, guesswork => 0, literal => 0 },
82    Verbatim => {                             guesswork => 0, literal => 1 },
83    C        => {                             guesswork => 0, literal => 1 },
84    X        => { cleanup => 0,               guesswork => 0               },
85);
86
87##############################################################################
88# Object initialization
89##############################################################################
90
91# Initialize the object and set various Pod::Simple options that we need.
92# Here, we also process any additional options passed to the constructor or
93# set up defaults if none were given.  Note that all internal object keys are
94# in all-caps, reserving all lower-case object keys for Pod::Simple and user
95# arguments.
96sub new {
97    my $class = shift;
98    my $self = $class->SUPER::new;
99
100    # Tell Pod::Simple not to handle S<> by automatically inserting &nbsp;.
101    $self->nbsp_for_S (1);
102
103    # Tell Pod::Simple to keep whitespace whenever possible.
104    if (my $preserve_whitespace = $self->can ('preserve_whitespace')) {
105        $self->$preserve_whitespace (1);
106    } else {
107        $self->fullstop_space_harden (1);
108    }
109
110    # The =for and =begin targets that we accept.
111    $self->accept_targets (qw/man MAN roff ROFF/);
112
113    # Ensure that contiguous blocks of code are merged together.  Otherwise,
114    # some of the guesswork heuristics don't work right.
115    $self->merge_text (1);
116
117    # Pod::Simple doesn't do anything useful with our arguments, but we want
118    # to put them in our object as hash keys and values.  This could cause
119    # problems if we ever clash with Pod::Simple's own internal class
120    # variables.
121    %$self = (%$self, @_);
122
123    # Send errors to stderr if requested.
124    if ($$self{stderr} and not $$self{errors}) {
125        $$self{errors} = 'stderr';
126    }
127    delete $$self{stderr};
128
129    # Validate the errors parameter and act on it.
130    if (not defined $$self{errors}) {
131        $$self{errors} = 'pod';
132    }
133    if ($$self{errors} eq 'stderr' || $$self{errors} eq 'die') {
134        $self->no_errata_section (1);
135        $self->complain_stderr (1);
136        if ($$self{errors} eq 'die') {
137            $$self{complain_die} = 1;
138        }
139    } elsif ($$self{errors} eq 'pod') {
140        $self->no_errata_section (0);
141        $self->complain_stderr (0);
142    } elsif ($$self{errors} eq 'none') {
143        $self->no_whining (1);
144    } else {
145        croak (qq(Invalid errors setting: "$$self{errors}"));
146    }
147    delete $$self{errors};
148
149    # Degrade back to non-utf8 if Encode is not available.
150    #
151    # Suppress the warning message when PERL_CORE is set, indicating this is
152    # running as part of the core Perl build.  Perl builds podlators (and all
153    # pure Perl modules) before Encode and other XS modules, so Encode won't
154    # yet be available.  Rely on the Perl core build to generate man pages
155    # later, after all the modules are available, so that UTF-8 handling will
156    # be correct.
157    if ($$self{utf8} and !$HAS_ENCODE) {
158        if (!$ENV{PERL_CORE}) {
159            carp ('utf8 mode requested but Encode module not available,'
160                    . ' falling back to non-utf8');
161        }
162        delete $$self{utf8};
163    }
164
165    # Initialize various other internal constants based on our arguments.
166    $self->init_fonts;
167    $self->init_quotes;
168    $self->init_page;
169
170    # For right now, default to turning on all of the magic.
171    $$self{MAGIC_CPP}       = 1;
172    $$self{MAGIC_EMDASH}    = 1;
173    $$self{MAGIC_FUNC}      = 1;
174    $$self{MAGIC_MANREF}    = 1;
175    $$self{MAGIC_SMALLCAPS} = 1;
176    $$self{MAGIC_VARS}      = 1;
177
178    return $self;
179}
180
181# Translate a font string into an escape.
182sub toescape { (length ($_[0]) > 1 ? '\f(' : '\f') . $_[0] }
183
184# Determine which fonts the user wishes to use and store them in the object.
185# Regular, italic, bold, and bold-italic are constants, but the fixed width
186# fonts may be set by the user.  Sets the internal hash key FONTS which is
187# used to map our internal font escapes to actual *roff sequences later.
188sub init_fonts {
189    my ($self) = @_;
190
191    # Figure out the fixed-width font.  If user-supplied, make sure that they
192    # are the right length.
193    for (qw/fixed fixedbold fixeditalic fixedbolditalic/) {
194        my $font = $$self{$_};
195        if (defined ($font) && (length ($font) < 1 || length ($font) > 2)) {
196            croak qq(roff font should be 1 or 2 chars, not "$font");
197        }
198    }
199
200    # Set the default fonts.  We can't be sure portably across different
201    # implementations what fixed bold-italic may be called (if it's even
202    # available), so default to just bold.
203    $$self{fixed}           ||= 'CW';
204    $$self{fixedbold}       ||= 'CB';
205    $$self{fixeditalic}     ||= 'CI';
206    $$self{fixedbolditalic} ||= 'CB';
207
208    # Set up a table of font escapes.  First number is fixed-width, second is
209    # bold, third is italic.
210    $$self{FONTS} = { '000' => '\fR', '001' => '\fI',
211                      '010' => '\fB', '011' => '\f(BI',
212                      '100' => toescape ($$self{fixed}),
213                      '101' => toescape ($$self{fixeditalic}),
214                      '110' => toescape ($$self{fixedbold}),
215                      '111' => toescape ($$self{fixedbolditalic}) };
216}
217
218# Initialize the quotes that we'll be using for C<> text.  This requires some
219# special handling, both to parse the user parameter if given and to make sure
220# that the quotes will be safe against *roff.  Sets the internal hash keys
221# LQUOTE and RQUOTE.
222sub init_quotes {
223    my ($self) = (@_);
224
225    $$self{quotes} ||= '"';
226    if ($$self{quotes} eq 'none') {
227        $$self{LQUOTE} = $$self{RQUOTE} = '';
228    } elsif (length ($$self{quotes}) == 1) {
229        $$self{LQUOTE} = $$self{RQUOTE} = $$self{quotes};
230    } elsif (length ($$self{quotes}) % 2 == 0) {
231        my $length = length ($$self{quotes}) / 2;
232        $$self{LQUOTE} = substr ($$self{quotes}, 0, $length);
233        $$self{RQUOTE} = substr ($$self{quotes}, $length);
234    } else {
235        croak(qq(Invalid quote specification "$$self{quotes}"))
236    }
237
238    # Double the first quote; note that this should not be s///g as two double
239    # quotes is represented in *roff as three double quotes, not four.  Weird,
240    # I know.
241    $$self{LQUOTE} =~ s/\"/\"\"/;
242    $$self{RQUOTE} =~ s/\"/\"\"/;
243}
244
245# Initialize the page title information and indentation from our arguments.
246sub init_page {
247    my ($self) = @_;
248
249    # We used to try first to get the version number from a local binary, but
250    # we shouldn't need that any more.  Get the version from the running Perl.
251    # Work a little magic to handle subversions correctly under both the
252    # pre-5.6 and the post-5.6 version numbering schemes.
253    my @version = ($] =~ /^(\d+)\.(\d{3})(\d{0,3})$/);
254    $version[2] ||= 0;
255    $version[2] *= 10 ** (3 - length $version[2]);
256    for (@version) { $_ += 0 }
257    my $version = join ('.', @version);
258
259    # Set the defaults for page titles and indentation if the user didn't
260    # override anything.
261    $$self{center} = 'User Contributed Perl Documentation'
262        unless defined $$self{center};
263    $$self{release} = 'perl v' . $version
264        unless defined $$self{release};
265    $$self{indent} = 4
266        unless defined $$self{indent};
267
268    # Double quotes in things that will be quoted.
269    for (qw/center release/) {
270        $$self{$_} =~ s/\"/\"\"/g if $$self{$_};
271    }
272}
273
274##############################################################################
275# Core parsing
276##############################################################################
277
278# This is the glue that connects the code below with Pod::Simple itself.  The
279# goal is to convert the event stream coming from the POD parser into method
280# calls to handlers once the complete content of a tag has been seen.  Each
281# paragraph or POD command will have textual content associated with it, and
282# as soon as all of a paragraph or POD command has been seen, that content
283# will be passed in to the corresponding method for handling that type of
284# object.  The exceptions are handlers for lists, which have opening tag
285# handlers and closing tag handlers that will be called right away.
286#
287# The internal hash key PENDING is used to store the contents of a tag until
288# all of it has been seen.  It holds a stack of open tags, each one
289# represented by a tuple of the attributes hash for the tag, formatting
290# options for the tag (which are inherited), and the contents of the tag.
291
292# Add a block of text to the contents of the current node, formatting it
293# according to the current formatting instructions as we do.
294sub _handle_text {
295    my ($self, $text) = @_;
296    DEBUG > 3 and print "== $text\n";
297    my $tag = $$self{PENDING}[-1];
298    $$tag[2] .= $self->format_text ($$tag[1], $text);
299}
300
301# Given an element name, get the corresponding method name.
302sub method_for_element {
303    my ($self, $element) = @_;
304    $element =~ tr/A-Z-/a-z_/;
305    $element =~ tr/_a-z0-9//cd;
306    return $element;
307}
308
309# Handle the start of a new element.  If cmd_element is defined, assume that
310# we need to collect the entire tree for this element before passing it to the
311# element method, and create a new tree into which we'll collect blocks of
312# text and nested elements.  Otherwise, if start_element is defined, call it.
313sub _handle_element_start {
314    my ($self, $element, $attrs) = @_;
315    DEBUG > 3 and print "++ $element (<", join ('> <', %$attrs), ">)\n";
316    my $method = $self->method_for_element ($element);
317
318    # If we have a command handler, we need to accumulate the contents of the
319    # tag before calling it.  Turn off IN_NAME for any command other than
320    # <Para> and the formatting codes so that IN_NAME isn't still set for the
321    # first heading after the NAME heading.
322    if ($self->can ("cmd_$method")) {
323        DEBUG > 2 and print "<$element> starts saving a tag\n";
324        $$self{IN_NAME} = 0 if ($element ne 'Para' && length ($element) > 1);
325
326        # How we're going to format embedded text blocks depends on the tag
327        # and also depends on our parent tags.  Thankfully, inside tags that
328        # turn off guesswork and reformatting, nothing else can turn it back
329        # on, so this can be strictly inherited.
330        my $formatting = {
331            %{ $$self{PENDING}[-1][1] || $FORMATTING{DEFAULT} },
332            %{ $FORMATTING{$element} || {} },
333        };
334        push (@{ $$self{PENDING} }, [ $attrs, $formatting, '' ]);
335        DEBUG > 4 and print "Pending: [", pretty ($$self{PENDING}), "]\n";
336    } elsif (my $start_method = $self->can ("start_$method")) {
337        $self->$start_method ($attrs, '');
338    } else {
339        DEBUG > 2 and print "No $method start method, skipping\n";
340    }
341}
342
343# Handle the end of an element.  If we had a cmd_ method for this element,
344# this is where we pass along the tree that we built.  Otherwise, if we have
345# an end_ method for the element, call that.
346sub _handle_element_end {
347    my ($self, $element) = @_;
348    DEBUG > 3 and print "-- $element\n";
349    my $method = $self->method_for_element ($element);
350
351    # If we have a command handler, pull off the pending text and pass it to
352    # the handler along with the saved attribute hash.
353    if (my $cmd_method = $self->can ("cmd_$method")) {
354        DEBUG > 2 and print "</$element> stops saving a tag\n";
355        my $tag = pop @{ $$self{PENDING} };
356        DEBUG > 4 and print "Popped: [", pretty ($tag), "]\n";
357        DEBUG > 4 and print "Pending: [", pretty ($$self{PENDING}), "]\n";
358        my $text = $self->$cmd_method ($$tag[0], $$tag[2]);
359        if (defined $text) {
360            if (@{ $$self{PENDING} } > 1) {
361                $$self{PENDING}[-1][2] .= $text;
362            } else {
363                $self->output ($text);
364            }
365        }
366    } elsif (my $end_method = $self->can ("end_$method")) {
367        $self->$end_method ();
368    } else {
369        DEBUG > 2 and print "No $method end method, skipping\n";
370    }
371}
372
373##############################################################################
374# General formatting
375##############################################################################
376
377# Format a text block.  Takes a hash of formatting options and the text to
378# format.  Currently, the only formatting options are guesswork, cleanup, and
379# convert, all of which are boolean.
380sub format_text {
381    my ($self, $options, $text) = @_;
382    my $guesswork = $$options{guesswork} && !$$self{IN_NAME};
383    my $cleanup = $$options{cleanup};
384    my $convert = $$options{convert};
385    my $literal = $$options{literal};
386
387    # Cleanup just tidies up a few things, telling *roff that the hyphens are
388    # hard, putting a bit of space between consecutive underscores, and
389    # escaping backslashes.  Be careful not to mangle our character
390    # translations by doing this before processing character translation.
391    if ($cleanup) {
392        $text =~ s/\\/\\e/g;
393        $text =~ s/-/\\-/g;
394        $text =~ s/_(?=_)/_\\|/g;
395    }
396
397    # Normally we do character translation, but we won't even do that in
398    # <Data> blocks or if UTF-8 output is desired.
399    if ($convert && !$$self{utf8} && ASCII) {
400        $text =~ s/([^\x00-\x7F])/$ESCAPES{ord ($1)} || "X"/eg;
401    }
402
403    # Ensure that *roff doesn't convert literal quotes to UTF-8 single quotes,
404    # but don't mess up our accept escapes.
405    if ($literal) {
406        $text =~ s/(?<!\\\*)\'/\\*\(Aq/g;
407        $text =~ s/(?<!\\\*)\`/\\\`/g;
408    }
409
410    # If guesswork is asked for, do that.  This involves more substantial
411    # formatting based on various heuristics that may only be appropriate for
412    # particular documents.
413    if ($guesswork) {
414        $text = $self->guesswork ($text);
415    }
416
417    return $text;
418}
419
420# Handles C<> text, deciding whether to put \*C` around it or not.  This is a
421# whole bunch of messy heuristics to try to avoid overquoting, originally from
422# Barrie Slaymaker.  This largely duplicates similar code in Pod::Text.
423sub quote_literal {
424    my $self = shift;
425    local $_ = shift;
426
427    # A regex that matches the portion of a variable reference that's the
428    # array or hash index, separated out just because we want to use it in
429    # several places in the following regex.
430    my $index = '(?: \[.*\] | \{.*\} )?';
431
432    # If in NAME section, just return an ASCII quoted string to avoid
433    # confusing tools like whatis.
434    return qq{"$_"} if $$self{IN_NAME};
435
436    # Check for things that we don't want to quote, and if we find any of
437    # them, return the string with just a font change and no quoting.
438    m{
439      ^\s*
440      (?:
441         ( [\'\`\"] ) .* \1                             # already quoted
442       | \\\*\(Aq .* \\\*\(Aq                           # quoted and escaped
443       | \\?\` .* ( \' | \\\*\(Aq )                     # `quoted'
444       | \$+ [\#^]? \S $index                           # special ($^Foo, $")
445       | [\$\@%&*]+ \#? [:\'\w]+ $index                 # plain var or func
446       | [\$\@%&*]* [:\'\w]+ (?: -> )? \(\s*[^\s,]\s*\) # 0/1-arg func call
447       | [-+]? ( \d[\d.]* | \.\d+ ) (?: [eE][-+]?\d+ )? # a number
448       | 0x [a-fA-F\d]+                                 # a hex constant
449      )
450      \s*\z
451     }xso and return '\f(FS' . $_ . '\f(FE';
452
453    # If we didn't return, go ahead and quote the text.
454    return '\f(FS\*(C`' . $_ . "\\*(C'\\f(FE";
455}
456
457# Takes a text block to perform guesswork on.  Returns the text block with
458# formatting codes added.  This is the code that marks up various Perl
459# constructs and things commonly used in man pages without requiring the user
460# to add any explicit markup, and is applied to all non-literal text.  We're
461# guaranteed that the text we're applying guesswork to does not contain any
462# *roff formatting codes.  Note that the inserted font sequences must be
463# treated later with mapfonts or textmapfonts.
464#
465# This method is very fragile, both in the regular expressions it uses and in
466# the ordering of those modifications.  Care and testing is required when
467# modifying it.
468sub guesswork {
469    my $self = shift;
470    local $_ = shift;
471    DEBUG > 5 and print "   Guesswork called on [$_]\n";
472
473    # By the time we reach this point, all hyphens will be escaped by adding a
474    # backslash.  We want to undo that escaping if they're part of regular
475    # words and there's only a single dash, since that's a real hyphen that
476    # *roff gets to consider a possible break point.  Make sure that a dash
477    # after the first character of a word stays non-breaking, however.
478    #
479    # Note that this is not user-controllable; we pretty much have to do this
480    # transformation or *roff will mangle the output in unacceptable ways.
481    s{
482        ( (?:\G|^|\s) [\(\"]* [a-zA-Z] ) ( \\- )?
483        ( (?: [a-zA-Z\']+ \\-)+ )
484        ( [a-zA-Z\']+ ) (?= [\)\".?!,;:]* (?:\s|\Z|\\\ ) )
485        \b
486    } {
487        my ($prefix, $hyphen, $main, $suffix) = ($1, $2, $3, $4);
488        $hyphen ||= '';
489        $main =~ s/\\-/-/g;
490        $prefix . $hyphen . $main . $suffix;
491    }egx;
492
493    # Translate "--" into a real em-dash if it's used like one.  This means
494    # that it's either surrounded by whitespace, it follows a regular word, or
495    # it occurs between two regular words.
496    if ($$self{MAGIC_EMDASH}) {
497        s{          (\s) \\-\\- (\s)                } { $1 . '\*(--' . $2 }egx;
498        s{ (\b[a-zA-Z]+) \\-\\- (\s|\Z|[a-zA-Z]+\b) } { $1 . '\*(--' . $2 }egx;
499    }
500
501    # Make words in all-caps a little bit smaller; they look better that way.
502    # However, we don't want to change Perl code (like @ARGV), nor do we want
503    # to fix the MIME in MIME-Version since it looks weird with the
504    # full-height V.
505    #
506    # We change only a string of all caps (2) either at the beginning of the
507    # line or following regular punctuation (like quotes) or whitespace (1),
508    # and followed by either similar punctuation, an em-dash, or the end of
509    # the line (3).
510    #
511    # Allow the text we're changing to small caps to include double quotes,
512    # commas, newlines, and periods as long as it doesn't otherwise interrupt
513    # the string of small caps and still fits the criteria.  This lets us turn
514    # entire warranty disclaimers in man page output into small caps.
515    if ($$self{MAGIC_SMALLCAPS}) {
516        s{
517            ( ^ | [\s\(\"\'\`\[\{<>] | \\[ ]  )                     # (1)
518            ( [A-Z] [A-Z] (?: [/A-Z+:\d_\$&] | \\- | [.,\"\s] )* )  # (2)
519            (?= [\s>\}\]\(\)\'\".?!,;] | \\*\(-- | \\[ ] | $ )      # (3)
520        } {
521            $1 . '\s-1' . $2 . '\s0'
522        }egx;
523    }
524
525    # Note that from this point forward, we have to adjust for \s-1 and \s-0
526    # strings inserted around things that we've made small-caps if later
527    # transforms should work on those strings.
528
529    # Italicize functions in the form func(), including functions that are in
530    # all capitals, but don't italize if there's anything between the parens.
531    # The function must start with an alphabetic character or underscore and
532    # then consist of word characters or colons.
533    if ($$self{MAGIC_FUNC}) {
534        s{
535            ( \b | \\s-1 )
536            ( [A-Za-z_] ([:\w] | \\s-?[01])+ \(\) )
537        } {
538            $1 . '\f(IS' . $2 . '\f(IE'
539        }egx;
540    }
541
542    # Change references to manual pages to put the page name in italics but
543    # the number in the regular font, with a thin space between the name and
544    # the number.  Only recognize func(n) where func starts with an alphabetic
545    # character or underscore and contains only word characters, periods (for
546    # configuration file man pages), or colons, and n is a single digit,
547    # optionally followed by some number of lowercase letters.  Note that this
548    # does not recognize man page references like perl(l) or socket(3SOCKET).
549    if ($$self{MAGIC_MANREF}) {
550        s{
551            ( \b | \\s-1 )
552            ( [A-Za-z_] (?:[.:\w] | \\- | \\s-?[01])+ )
553            ( \( \d [a-z]* \) )
554        } {
555            $1 . '\f(IS' . $2 . '\f(IE\|' . $3
556        }egx;
557    }
558
559    # Convert simple Perl variable references to a fixed-width font.  Be
560    # careful not to convert functions, though; there are too many subtleties
561    # with them to want to perform this transformation.
562    if ($$self{MAGIC_VARS}) {
563        s{
564           ( ^ | \s+ )
565           ( [\$\@%] [\w:]+ )
566           (?! \( )
567        } {
568            $1 . '\f(FS' . $2 . '\f(FE'
569        }egx;
570    }
571
572    # Fix up double quotes.  Unfortunately, we miss this transformation if the
573    # quoted text contains any code with formatting codes and there's not much
574    # we can effectively do about that, which makes it somewhat unclear if
575    # this is really a good idea.
576    s{ \" ([^\"]+) \" } { '\*(L"' . $1 . '\*(R"' }egx;
577
578    # Make C++ into \*(C+, which is a squinched version.
579    if ($$self{MAGIC_CPP}) {
580        s{ \b C\+\+ } {\\*\(C+}gx;
581    }
582
583    # Done.
584    DEBUG > 5 and print "   Guesswork returning [$_]\n";
585    return $_;
586}
587
588##############################################################################
589# Output
590##############################################################################
591
592# When building up the *roff code, we don't use real *roff fonts.  Instead, we
593# embed font codes of the form \f(<font>[SE] where <font> is one of B, I, or
594# F, S stands for start, and E stands for end.  This method turns these into
595# the right start and end codes.
596#
597# We add this level of complexity because the old pod2man didn't get code like
598# B<someI<thing> else> right; after I<> it switched back to normal text rather
599# than bold.  We take care of this by using variables that state whether bold,
600# italic, or fixed are turned on as a combined pointer to our current font
601# sequence, and set each to the number of current nestings of start tags for
602# that font.
603#
604# \fP changes to the previous font, but only one previous font is kept.  We
605# don't know what the outside level font is; normally it's R, but if we're
606# inside a heading it could be something else.  So arrange things so that the
607# outside font is always the "previous" font and end with \fP instead of \fR.
608# Idea from Zack Weinberg.
609sub mapfonts {
610    my ($self, $text) = @_;
611    my ($fixed, $bold, $italic) = (0, 0, 0);
612    my %magic = (F => \$fixed, B => \$bold, I => \$italic);
613    my $last = '\fR';
614    $text =~ s<
615        \\f\((.)(.)
616    > <
617        my $sequence = '';
618        my $f;
619        if ($last ne '\fR') { $sequence = '\fP' }
620        ${ $magic{$1} } += ($2 eq 'S') ? 1 : -1;
621        $f = $$self{FONTS}{ ($fixed && 1) . ($bold && 1) . ($italic && 1) };
622        if ($f eq $last) {
623            '';
624        } else {
625            if ($f ne '\fR') { $sequence .= $f }
626            $last = $f;
627            $sequence;
628        }
629    >gxe;
630    return $text;
631}
632
633# Unfortunately, there is a bug in Solaris 2.6 nroff (not present in GNU
634# groff) where the sequence \fB\fP\f(CW\fP leaves the font set to B rather
635# than R, presumably because \f(CW doesn't actually do a font change.  To work
636# around this, use a separate textmapfonts for text blocks where the default
637# font is always R and only use the smart mapfonts for headings.
638sub textmapfonts {
639    my ($self, $text) = @_;
640    my ($fixed, $bold, $italic) = (0, 0, 0);
641    my %magic = (F => \$fixed, B => \$bold, I => \$italic);
642    $text =~ s<
643        \\f\((.)(.)
644    > <
645        ${ $magic{$1} } += ($2 eq 'S') ? 1 : -1;
646        $$self{FONTS}{ ($fixed && 1) . ($bold && 1) . ($italic && 1) };
647    >gxe;
648    return $text;
649}
650
651# Given a command and a single argument that may or may not contain double
652# quotes, handle double-quote formatting for it.  If there are no double
653# quotes, just return the command followed by the argument in double quotes.
654# If there are double quotes, use an if statement to test for nroff, and for
655# nroff output the command followed by the argument in double quotes with
656# embedded double quotes doubled.  For other formatters, remap paired double
657# quotes to LQUOTE and RQUOTE.
658sub switchquotes {
659    my ($self, $command, $text, $extra) = @_;
660    $text =~ s/\\\*\([LR]\"/\"/g;
661
662    # We also have to deal with \*C` and \*C', which are used to add the
663    # quotes around C<> text, since they may expand to " and if they do this
664    # confuses the .SH macros and the like no end.  Expand them ourselves.
665    # Also separate troff from nroff if there are any fixed-width fonts in use
666    # to work around problems with Solaris nroff.
667    my $c_is_quote = ($$self{LQUOTE} =~ /\"/) || ($$self{RQUOTE} =~ /\"/);
668    my $fixedpat = join '|', @{ $$self{FONTS} }{'100', '101', '110', '111'};
669    $fixedpat =~ s/\\/\\\\/g;
670    $fixedpat =~ s/\(/\\\(/g;
671    if ($text =~ m/\"/ || $text =~ m/$fixedpat/) {
672        $text =~ s/\"/\"\"/g;
673        my $nroff = $text;
674        my $troff = $text;
675        $troff =~ s/\"\"([^\"]*)\"\"/\`\`$1\'\'/g;
676        if ($c_is_quote and $text =~ m/\\\*\(C[\'\`]/) {
677            $nroff =~ s/\\\*\(C\`/$$self{LQUOTE}/g;
678            $nroff =~ s/\\\*\(C\'/$$self{RQUOTE}/g;
679            $troff =~ s/\\\*\(C[\'\`]//g;
680        }
681        $nroff = qq("$nroff") . ($extra ? " $extra" : '');
682        $troff = qq("$troff") . ($extra ? " $extra" : '');
683
684        # Work around the Solaris nroff bug where \f(CW\fP leaves the font set
685        # to Roman rather than the actual previous font when used in headings.
686        # troff output may still be broken, but at least we can fix nroff by
687        # just switching the font changes to the non-fixed versions.
688        my $font_end = "(?:\\f[PR]|\Q$$self{FONTS}{100}\E)";
689        $nroff =~ s/\Q$$self{FONTS}{100}\E(.*?)\\f([PR])/$1/g;
690        $nroff =~ s/\Q$$self{FONTS}{101}\E(.*?)$font_end/\\fI$1\\fP/g;
691        $nroff =~ s/\Q$$self{FONTS}{110}\E(.*?)$font_end/\\fB$1\\fP/g;
692        $nroff =~ s/\Q$$self{FONTS}{111}\E(.*?)$font_end/\\f\(BI$1\\fP/g;
693
694        # Now finally output the command.  Bother with .ie only if the nroff
695        # and troff output aren't the same.
696        if ($nroff ne $troff) {
697            return ".ie n $command $nroff\n.el $command $troff\n";
698        } else {
699            return "$command $nroff\n";
700        }
701    } else {
702        $text = qq("$text") . ($extra ? " $extra" : '');
703        return "$command $text\n";
704    }
705}
706
707# Protect leading quotes and periods against interpretation as commands.  Also
708# protect anything starting with a backslash, since it could expand or hide
709# something that *roff would interpret as a command.  This is overkill, but
710# it's much simpler than trying to parse *roff here.
711sub protect {
712    my ($self, $text) = @_;
713    $text =~ s/^([.\'\\])/\\&$1/mg;
714    return $text;
715}
716
717# Make vertical whitespace if NEEDSPACE is set, appropriate to the indentation
718# level the situation.  This function is needed since in *roff one has to
719# create vertical whitespace after paragraphs and between some things, but
720# other macros create their own whitespace.  Also close out a sequence of
721# repeated =items, since calling makespace means we're about to begin the item
722# body.
723sub makespace {
724    my ($self) = @_;
725    $self->output (".PD\n") if $$self{ITEMS} > 1;
726    $$self{ITEMS} = 0;
727    $self->output ($$self{INDENT} > 0 ? ".Sp\n" : ".PP\n")
728        if $$self{NEEDSPACE};
729}
730
731# Output any pending index entries, and optionally an index entry given as an
732# argument.  Support multiple index entries in X<> separated by slashes, and
733# strip special escapes from index entries.
734sub outindex {
735    my ($self, $section, $index) = @_;
736    my @entries = map { split m%\s*/\s*% } @{ $$self{INDEX} };
737    return unless ($section || @entries);
738
739    # We're about to output all pending entries, so clear our pending queue.
740    $$self{INDEX} = [];
741
742    # Build the output.  Regular index entries are marked Xref, and headings
743    # pass in their own section.  Undo some *roff formatting on headings.
744    my @output;
745    if (@entries) {
746        push @output, [ 'Xref', join (' ', @entries) ];
747    }
748    if ($section) {
749        $index =~ s/\\-/-/g;
750        $index =~ s/\\(?:s-?\d|.\(..|.)//g;
751        push @output, [ $section, $index ];
752    }
753
754    # Print out the .IX commands.
755    for (@output) {
756        my ($type, $entry) = @$_;
757        $entry =~ s/\s+/ /g;
758        $entry =~ s/\"/\"\"/g;
759        $entry =~ s/\\/\\\\/g;
760        $self->output (".IX $type " . '"' . $entry . '"' . "\n");
761    }
762}
763
764# Output some text, without any additional changes.
765sub output {
766    my ($self, @text) = @_;
767    if ($$self{ENCODE}) {
768        print { $$self{output_fh} } Encode::encode ('UTF-8', join ('', @text));
769    } else {
770        print { $$self{output_fh} } @text;
771    }
772}
773
774##############################################################################
775# Document initialization
776##############################################################################
777
778# Handle the start of the document.  Here we handle empty documents, as well
779# as setting up our basic macros in a preamble and building the page title.
780sub start_document {
781    my ($self, $attrs) = @_;
782    if ($$attrs{contentless} && !$$self{ALWAYS_EMIT_SOMETHING}) {
783        DEBUG and print "Document is contentless\n";
784        $$self{CONTENTLESS} = 1;
785    } else {
786        delete $$self{CONTENTLESS};
787    }
788
789    # When UTF-8 output is set, check whether our output file handle already
790    # has a PerlIO encoding layer set.  If it does not, we'll need to encode
791    # our output before printing it (handled in the output() sub).  Wrap the
792    # check in an eval to handle versions of Perl without PerlIO.
793    $$self{ENCODE} = 0;
794    if ($$self{utf8}) {
795        $$self{ENCODE} = 1;
796        eval {
797            my @options = (output => 1, details => 1);
798            my $flag = (PerlIO::get_layers ($$self{output_fh}, @options))[-1];
799            if ($flag & PerlIO::F_UTF8 ()) {
800                $$self{ENCODE} = 0;
801            }
802        }
803    }
804
805    # Determine information for the preamble and then output it unless the
806    # document was content-free.
807    if (!$$self{CONTENTLESS}) {
808        my ($name, $section);
809        if (defined $$self{name}) {
810            $name = $$self{name};
811            $section = $$self{section} || 1;
812        } else {
813            ($name, $section) = $self->devise_title;
814        }
815        my $date = defined($$self{date}) ? $$self{date} : $self->devise_date;
816        $self->preamble ($name, $section, $date)
817            unless $self->bare_output or DEBUG > 9;
818    }
819
820    # Initialize a few per-document variables.
821    $$self{INDENT}    = 0;      # Current indentation level.
822    $$self{INDENTS}   = [];     # Stack of indentations.
823    $$self{INDEX}     = [];     # Index keys waiting to be printed.
824    $$self{IN_NAME}   = 0;      # Whether processing the NAME section.
825    $$self{ITEMS}     = 0;      # The number of consecutive =items.
826    $$self{ITEMTYPES} = [];     # Stack of =item types, one per list.
827    $$self{SHIFTWAIT} = 0;      # Whether there is a shift waiting.
828    $$self{SHIFTS}    = [];     # Stack of .RS shifts.
829    $$self{PENDING}   = [[]];   # Pending output.
830}
831
832# Handle the end of the document.  This handles dying on POD errors, since
833# Pod::Parser currently doesn't.  Otherwise, does nothing but print out a
834# final comment at the end of the document under debugging.
835sub end_document {
836    my ($self) = @_;
837    if ($$self{complain_die} && $self->errors_seen) {
838        croak ("POD document had syntax errors");
839    }
840    return if $self->bare_output;
841    return if ($$self{CONTENTLESS} && !$$self{ALWAYS_EMIT_SOMETHING});
842    $self->output (q(.\" [End document]) . "\n") if DEBUG;
843}
844
845# Try to figure out the name and section from the file name and return them as
846# a list, returning an empty name and section 1 if we can't find any better
847# information.  Uses File::Basename and File::Spec as necessary.
848sub devise_title {
849    my ($self) = @_;
850    my $name = $self->source_filename || '';
851    my $section = $$self{section} || 1;
852    $section = 3 if (!$$self{section} && $name =~ /\.pm\z/i);
853    $name =~ s/\.p(od|[lm])\z//i;
854
855    # If Pod::Parser gave us an IO::File reference as the source file name,
856    # convert that to the empty string as well.  Then, if we don't have a
857    # valid name, emit a warning and convert it to STDIN.
858    if ($name =~ /^IO::File(?:=\w+)\(0x[\da-f]+\)$/i) {
859        $name = '';
860    }
861    if ($name eq '') {
862        $self->whine (1, 'No name given for document');
863        $name = 'STDIN';
864    }
865
866    # If the section isn't 3, then the name defaults to just the basename of
867    # the file.
868    if ($section !~ /^3/) {
869        require File::Basename;
870        $name = uc File::Basename::basename ($name);
871    } else {
872        require File::Spec;
873        my ($volume, $dirs, $file) = File::Spec->splitpath ($name);
874
875        # Otherwise, assume we're dealing with a module.  We want to figure
876        # out the full module name from the path to the file, but we don't
877        # want to include too much of the path into the module name.  Lose
878        # anything up to the first of:
879        #
880        #     */lib/*perl*/         standard or site_perl module
881        #     */*perl*/lib/         from -Dprefix=/opt/perl
882        #     */*perl*/             random module hierarchy
883        #
884        # Also strip off a leading site, site_perl, or vendor_perl component,
885        # any OS-specific component, and any version number component, and
886        # strip off an initial component of "lib" or "blib/lib" since that's
887        # what ExtUtils::MakeMaker creates.
888        #
889        # splitdir requires at least File::Spec 0.8.
890        my @dirs = File::Spec->splitdir ($dirs);
891        if (@dirs) {
892            my $cut = 0;
893            my $i;
894            for ($i = 0; $i < @dirs; $i++) {
895                if ($dirs[$i] =~ /perl/) {
896                    $cut = $i + 1;
897                    $cut++ if ($dirs[$i + 1] && $dirs[$i + 1] eq 'lib');
898                    last;
899                } elsif ($dirs[$i] eq 'lib' && $dirs[$i + 1] && $dirs[0] eq 'ext') {
900                    $cut = $i + 1;
901                }
902            }
903            if ($cut > 0) {
904                splice (@dirs, 0, $cut);
905                shift @dirs if ($dirs[0] =~ /^(site|vendor)(_perl)?$/);
906                shift @dirs if ($dirs[0] =~ /^[\d.]+$/);
907                shift @dirs if ($dirs[0] =~ /^(.*-$^O|$^O-.*|$^O)$/);
908            }
909            shift @dirs if $dirs[0] eq 'lib';
910            splice (@dirs, 0, 2) if ($dirs[0] eq 'blib' && $dirs[1] eq 'lib');
911        }
912
913        # Remove empty directories when building the module name; they
914        # occur too easily on Unix by doubling slashes.
915        $name = join ('::', (grep { $_ ? $_ : () } @dirs), $file);
916    }
917    return ($name, $section);
918}
919
920# Determine the modification date and return that, properly formatted in ISO
921# format.
922#
923# If POD_MAN_DATE is set, that overrides anything else.  This can be used for
924# reproducible generation of the same file even if the input file timestamps
925# are unpredictable or the POD coms from standard input.
926#
927# Otherwise, if SOURCE_DATE_EPOCH is set and can be parsed as seconds since
928# the UNIX epoch, base the timestamp on that.  See
929# <https://reproducible-builds.org/specs/source-date-epoch/>
930#
931# Otherwise, use the modification date of the input if we can stat it.  Be
932# aware that Pod::Simple returns the stringification of the file handle as
933# source_filename for input from a file handle, so we'll stat some random ref
934# string in that case.  If that fails, instead use the current time.
935#
936# $self - Pod::Man object, used to get the source file
937#
938# Returns: YYYY-MM-DD date suitable for the left-hand footer
939sub devise_date {
940    my ($self) = @_;
941
942    # If POD_MAN_DATE is set, always use it.
943    if (defined($ENV{POD_MAN_DATE})) {
944        return $ENV{POD_MAN_DATE};
945    }
946
947    # If SOURCE_DATE_EPOCH is set and can be parsed, use that.
948    my $time;
949    if (defined($ENV{SOURCE_DATE_EPOCH}) && $ENV{SOURCE_DATE_EPOCH} !~ /\D/) {
950        $time = $ENV{SOURCE_DATE_EPOCH};
951    }
952
953    # Otherwise, get the input filename and try to stat it.  If that fails,
954    # use the current time.
955    if (!defined $time) {
956        my $input = $self->source_filename;
957        if ($input) {
958            $time = (stat($input))[9] || time();
959        } else {
960            $time = time();
961        }
962    }
963
964    # Can't use POSIX::strftime(), which uses Fcntl, because MakeMaker uses
965    # this and it has to work in the core which can't load dynamic libraries.
966    # Use gmtime instead of localtime so that the generated man page does not
967    # depend on the local time zone setting and is more reproducible
968    my ($year, $month, $day) = (gmtime($time))[5,4,3];
969    return sprintf("%04d-%02d-%02d", $year + 1900, $month + 1, $day);
970}
971
972# Print out the preamble and the title.  The meaning of the arguments to .TH
973# unfortunately vary by system; some systems consider the fourth argument to
974# be a "source" and others use it as a version number.  Generally it's just
975# presented as the left-side footer, though, so it doesn't matter too much if
976# a particular system gives it another interpretation.
977#
978# The order of date and release used to be reversed in older versions of this
979# module, but this order is correct for both Solaris and Linux.
980sub preamble {
981    my ($self, $name, $section, $date) = @_;
982    my $preamble = $self->preamble_template (!$$self{utf8});
983
984    # Build the index line and make sure that it will be syntactically valid.
985    my $index = "$name $section";
986    $index =~ s/\"/\"\"/g;
987
988    # If name or section contain spaces, quote them (section really never
989    # should, but we may as well be cautious).
990    for ($name, $section) {
991        if (/\s/) {
992            s/\"/\"\"/g;
993            $_ = '"' . $_ . '"';
994        }
995    }
996
997    # Double quotes in date, since it will be quoted.
998    $date =~ s/\"/\"\"/g;
999
1000    # Substitute into the preamble the configuration options.
1001    $preamble =~ s/\@CFONT\@/$$self{fixed}/;
1002    $preamble =~ s/\@LQUOTE\@/$$self{LQUOTE}/;
1003    $preamble =~ s/\@RQUOTE\@/$$self{RQUOTE}/;
1004    chomp $preamble;
1005
1006    # Get the version information.
1007    my $version = $self->version_report;
1008
1009    # Finally output everything.
1010    $self->output (<<"----END OF HEADER----");
1011.\\" Automatically generated by $version
1012.\\"
1013.\\" Standard preamble:
1014.\\" ========================================================================
1015$preamble
1016.\\" ========================================================================
1017.\\"
1018.IX Title "$index"
1019.TH $name $section "$date" "$$self{release}" "$$self{center}"
1020.\\" For nroff, turn off justification.  Always turn off hyphenation; it makes
1021.\\" way too many mistakes in technical documents.
1022.if n .ad l
1023.nh
1024----END OF HEADER----
1025    $self->output (".\\\" [End of preamble]\n") if DEBUG;
1026}
1027
1028##############################################################################
1029# Text blocks
1030##############################################################################
1031
1032# Handle a basic block of text.  The only tricky part of this is if this is
1033# the first paragraph of text after an =over, in which case we have to change
1034# indentations for *roff.
1035sub cmd_para {
1036    my ($self, $attrs, $text) = @_;
1037    my $line = $$attrs{start_line};
1038
1039    # Output the paragraph.  We also have to handle =over without =item.  If
1040    # there's an =over without =item, SHIFTWAIT will be set, and we need to
1041    # handle creation of the indent here.  Add the shift to SHIFTS so that it
1042    # will be cleaned up on =back.
1043    $self->makespace;
1044    if ($$self{SHIFTWAIT}) {
1045        $self->output (".RS $$self{INDENT}\n");
1046        push (@{ $$self{SHIFTS} }, $$self{INDENT});
1047        $$self{SHIFTWAIT} = 0;
1048    }
1049
1050    # Add the line number for debugging, but not in the NAME section just in
1051    # case the comment would confuse apropos.
1052    $self->output (".\\\" [At source line $line]\n")
1053        if defined ($line) && DEBUG && !$$self{IN_NAME};
1054
1055    # Force exactly one newline at the end and strip unwanted trailing
1056    # whitespace at the end, but leave "\ " backslashed space from an S< > at
1057    # the end of a line.  Reverse the text first, to avoid having to scan the
1058    # entire paragraph.
1059    $text = reverse $text;
1060    $text =~ s/\A\s*?(?= \\|\S|\z)/\n/;
1061    $text = reverse $text;
1062
1063    # Output the paragraph.
1064    $self->output ($self->protect ($self->textmapfonts ($text)));
1065    $self->outindex;
1066    $$self{NEEDSPACE} = 1;
1067    return '';
1068}
1069
1070# Handle a verbatim paragraph.  Put a null token at the beginning of each line
1071# to protect against commands and wrap in .Vb/.Ve (which we define in our
1072# prelude).
1073sub cmd_verbatim {
1074    my ($self, $attrs, $text) = @_;
1075
1076    # Ignore an empty verbatim paragraph.
1077    return unless $text =~ /\S/;
1078
1079    # Force exactly one newline at the end and strip unwanted trailing
1080    # whitespace at the end.  Reverse the text first, to avoid having to scan
1081    # the entire paragraph.
1082    $text = reverse $text;
1083    $text =~ s/\A\s*/\n/;
1084    $text = reverse $text;
1085
1086    # Get a count of the number of lines before the first blank line, which
1087    # we'll pass to .Vb as its parameter.  This tells *roff to keep that many
1088    # lines together.  We don't want to tell *roff to keep huge blocks
1089    # together.
1090    my @lines = split (/\n/, $text);
1091    my $unbroken = 0;
1092    for (@lines) {
1093        last if /^\s*$/;
1094        $unbroken++;
1095    }
1096    $unbroken = 10 if ($unbroken > 12 && !$$self{MAGIC_VNOPAGEBREAK_LIMIT});
1097
1098    # Prepend a null token to each line.
1099    $text =~ s/^/\\&/gm;
1100
1101    # Output the results.
1102    $self->makespace;
1103    $self->output (".Vb $unbroken\n$text.Ve\n");
1104    $$self{NEEDSPACE} = 1;
1105    return '';
1106}
1107
1108# Handle literal text (produced by =for and similar constructs).  Just output
1109# it with the minimum of changes.
1110sub cmd_data {
1111    my ($self, $attrs, $text) = @_;
1112    $text =~ s/^\n+//;
1113    $text =~ s/\n{0,2}$/\n/;
1114    $self->output ($text);
1115    return '';
1116}
1117
1118##############################################################################
1119# Headings
1120##############################################################################
1121
1122# Common code for all headings.  This is called before the actual heading is
1123# output.  It returns the cleaned up heading text (putting the heading all on
1124# one line) and may do other things, like closing bad =item blocks.
1125sub heading_common {
1126    my ($self, $text, $line) = @_;
1127    $text =~ s/\s+$//;
1128    $text =~ s/\s*\n\s*/ /g;
1129
1130    # This should never happen; it means that we have a heading after =item
1131    # without an intervening =back.  But just in case, handle it anyway.
1132    if ($$self{ITEMS} > 1) {
1133        $$self{ITEMS} = 0;
1134        $self->output (".PD\n");
1135    }
1136
1137    # Output the current source line.
1138    $self->output ( ".\\\" [At source line $line]\n" )
1139        if defined ($line) && DEBUG;
1140    return $text;
1141}
1142
1143# First level heading.  We can't output .IX in the NAME section due to a bug
1144# in some versions of catman, so don't output a .IX for that section.  .SH
1145# already uses small caps, so remove \s0 and \s-1.  Maintain IN_NAME as
1146# appropriate.
1147sub cmd_head1 {
1148    my ($self, $attrs, $text) = @_;
1149    $text =~ s/\\s-?\d//g;
1150    $text = $self->heading_common ($text, $$attrs{start_line});
1151    my $isname = ($text eq 'NAME' || $text =~ /\(NAME\)/);
1152    $self->output ($self->switchquotes ('.SH', $self->mapfonts ($text)));
1153    $self->outindex ('Header', $text) unless $isname;
1154    $$self{NEEDSPACE} = 0;
1155    $$self{IN_NAME} = $isname;
1156    return '';
1157}
1158
1159# Second level heading.
1160sub cmd_head2 {
1161    my ($self, $attrs, $text) = @_;
1162    $text = $self->heading_common ($text, $$attrs{start_line});
1163    $self->output ($self->switchquotes ('.SS', $self->mapfonts ($text)));
1164    $self->outindex ('Subsection', $text);
1165    $$self{NEEDSPACE} = 0;
1166    return '';
1167}
1168
1169# Third level heading.  *roff doesn't have this concept, so just put the
1170# heading in italics as a normal paragraph.
1171sub cmd_head3 {
1172    my ($self, $attrs, $text) = @_;
1173    $text = $self->heading_common ($text, $$attrs{start_line});
1174    $self->makespace;
1175    $self->output ($self->textmapfonts ('\f(IS' . $text . '\f(IE') . "\n");
1176    $self->outindex ('Subsection', $text);
1177    $$self{NEEDSPACE} = 1;
1178    return '';
1179}
1180
1181# Fourth level heading.  *roff doesn't have this concept, so just put the
1182# heading as a normal paragraph.
1183sub cmd_head4 {
1184    my ($self, $attrs, $text) = @_;
1185    $text = $self->heading_common ($text, $$attrs{start_line});
1186    $self->makespace;
1187    $self->output ($self->textmapfonts ($text) . "\n");
1188    $self->outindex ('Subsection', $text);
1189    $$self{NEEDSPACE} = 1;
1190    return '';
1191}
1192
1193##############################################################################
1194# Formatting codes
1195##############################################################################
1196
1197# All of the formatting codes that aren't handled internally by the parser,
1198# other than L<> and X<>.
1199sub cmd_b { return $_[0]->{IN_NAME} ? $_[2] : '\f(BS' . $_[2] . '\f(BE' }
1200sub cmd_i { return $_[0]->{IN_NAME} ? $_[2] : '\f(IS' . $_[2] . '\f(IE' }
1201sub cmd_f { return $_[0]->{IN_NAME} ? $_[2] : '\f(IS' . $_[2] . '\f(IE' }
1202sub cmd_c { return $_[0]->quote_literal ($_[2]) }
1203
1204# Index entries are just added to the pending entries.
1205sub cmd_x {
1206    my ($self, $attrs, $text) = @_;
1207    push (@{ $$self{INDEX} }, $text);
1208    return '';
1209}
1210
1211# Links reduce to the text that we're given, wrapped in angle brackets if it's
1212# a URL, followed by the URL.  We take an option to suppress the URL if anchor
1213# text is given.  We need to format the "to" value of the link before
1214# comparing it to the text since we may escape hyphens.
1215sub cmd_l {
1216    my ($self, $attrs, $text) = @_;
1217    if ($$attrs{type} eq 'url') {
1218        my $to = $$attrs{to};
1219        if (defined $to) {
1220            my $tag = $$self{PENDING}[-1];
1221            $to = $self->format_text ($$tag[1], $to);
1222        }
1223        if (not defined ($to) or $to eq $text) {
1224            return "<$text>";
1225        } elsif ($$self{nourls}) {
1226            return $text;
1227        } else {
1228            return "$text <$$attrs{to}>";
1229        }
1230    } else {
1231        return $text;
1232    }
1233}
1234
1235##############################################################################
1236# List handling
1237##############################################################################
1238
1239# Handle the beginning of an =over block.  Takes the type of the block as the
1240# first argument, and then the attr hash.  This is called by the handlers for
1241# the four different types of lists (bullet, number, text, and block).
1242sub over_common_start {
1243    my ($self, $type, $attrs) = @_;
1244    my $line = $$attrs{start_line};
1245    my $indent = $$attrs{indent};
1246    DEBUG > 3 and print " Starting =over $type (line $line, indent ",
1247        ($indent || '?'), "\n";
1248
1249    # Find the indentation level.
1250    unless (defined ($indent) && $indent =~ /^[-+]?\d{1,4}\s*$/) {
1251        $indent = $$self{indent};
1252    }
1253
1254    # If we've gotten multiple indentations in a row, we need to emit the
1255    # pending indentation for the last level that we saw and haven't acted on
1256    # yet.  SHIFTS is the stack of indentations that we've actually emitted
1257    # code for.
1258    if (@{ $$self{SHIFTS} } < @{ $$self{INDENTS} }) {
1259        $self->output (".RS $$self{INDENT}\n");
1260        push (@{ $$self{SHIFTS} }, $$self{INDENT});
1261    }
1262
1263    # Now, do record-keeping.  INDENTS is a stack of indentations that we've
1264    # seen so far, and INDENT is the current level of indentation.  ITEMTYPES
1265    # is a stack of list types that we've seen.
1266    push (@{ $$self{INDENTS} }, $$self{INDENT});
1267    push (@{ $$self{ITEMTYPES} }, $type);
1268    $$self{INDENT} = $indent + 0;
1269    $$self{SHIFTWAIT} = 1;
1270}
1271
1272# End an =over block.  Takes no options other than the class pointer.
1273# Normally, once we close a block and therefore remove something from INDENTS,
1274# INDENTS will now be longer than SHIFTS, indicating that we also need to emit
1275# *roff code to close the indent.  This isn't *always* true, depending on the
1276# circumstance.  If we're still inside an indentation, we need to emit another
1277# .RE and then a new .RS to unconfuse *roff.
1278sub over_common_end {
1279    my ($self) = @_;
1280    DEBUG > 3 and print " Ending =over\n";
1281    $$self{INDENT} = pop @{ $$self{INDENTS} };
1282    pop @{ $$self{ITEMTYPES} };
1283
1284    # If we emitted code for that indentation, end it.
1285    if (@{ $$self{SHIFTS} } > @{ $$self{INDENTS} }) {
1286        $self->output (".RE\n");
1287        pop @{ $$self{SHIFTS} };
1288    }
1289
1290    # If we're still in an indentation, *roff will have now lost track of the
1291    # right depth of that indentation, so fix that.
1292    if (@{ $$self{INDENTS} } > 0) {
1293        $self->output (".RE\n");
1294        $self->output (".RS $$self{INDENT}\n");
1295    }
1296    $$self{NEEDSPACE} = 1;
1297    $$self{SHIFTWAIT} = 0;
1298}
1299
1300# Dispatch the start and end calls as appropriate.
1301sub start_over_bullet { my $s = shift; $s->over_common_start ('bullet', @_) }
1302sub start_over_number { my $s = shift; $s->over_common_start ('number', @_) }
1303sub start_over_text   { my $s = shift; $s->over_common_start ('text',   @_) }
1304sub start_over_block  { my $s = shift; $s->over_common_start ('block',  @_) }
1305sub end_over_bullet { $_[0]->over_common_end }
1306sub end_over_number { $_[0]->over_common_end }
1307sub end_over_text   { $_[0]->over_common_end }
1308sub end_over_block  { $_[0]->over_common_end }
1309
1310# The common handler for all item commands.  Takes the type of the item, the
1311# attributes, and then the text of the item.
1312#
1313# Emit an index entry for anything that's interesting, but don't emit index
1314# entries for things like bullets and numbers.  Newlines in an item title are
1315# turned into spaces since *roff can't handle them embedded.
1316sub item_common {
1317    my ($self, $type, $attrs, $text) = @_;
1318    my $line = $$attrs{start_line};
1319    DEBUG > 3 and print "  $type item (line $line): $text\n";
1320
1321    # Clean up the text.  We want to end up with two variables, one ($text)
1322    # which contains any body text after taking out the item portion, and
1323    # another ($item) which contains the actual item text.
1324    $text =~ s/\s+$//;
1325    my ($item, $index);
1326    if ($type eq 'bullet') {
1327        $item = "\\\(bu";
1328        $text =~ s/\n*$/\n/;
1329    } elsif ($type eq 'number') {
1330        $item = $$attrs{number} . '.';
1331    } else {
1332        $item = $text;
1333        $item =~ s/\s*\n\s*/ /g;
1334        $text = '';
1335        $index = $item if ($item =~ /\w/);
1336    }
1337
1338    # Take care of the indentation.  If shifts and indents are equal, close
1339    # the top shift, since we're about to create an indentation with .IP.
1340    # Also output .PD 0 to turn off spacing between items if this item is
1341    # directly following another one.  We only have to do that once for a
1342    # whole chain of items so do it for the second item in the change.  Note
1343    # that makespace is what undoes this.
1344    if (@{ $$self{SHIFTS} } == @{ $$self{INDENTS} }) {
1345        $self->output (".RE\n");
1346        pop @{ $$self{SHIFTS} };
1347    }
1348    $self->output (".PD 0\n") if ($$self{ITEMS} == 1);
1349
1350    # Now, output the item tag itself.
1351    $item = $self->textmapfonts ($item);
1352    $self->output ($self->switchquotes ('.IP', $item, $$self{INDENT}));
1353    $$self{NEEDSPACE} = 0;
1354    $$self{ITEMS}++;
1355    $$self{SHIFTWAIT} = 0;
1356
1357    # If body text for this item was included, go ahead and output that now.
1358    if ($text) {
1359        $text =~ s/\s*$/\n/;
1360        $self->makespace;
1361        $self->output ($self->protect ($self->textmapfonts ($text)));
1362        $$self{NEEDSPACE} = 1;
1363    }
1364    $self->outindex ($index ? ('Item', $index) : ());
1365}
1366
1367# Dispatch the item commands to the appropriate place.
1368sub cmd_item_bullet { my $self = shift; $self->item_common ('bullet', @_) }
1369sub cmd_item_number { my $self = shift; $self->item_common ('number', @_) }
1370sub cmd_item_text   { my $self = shift; $self->item_common ('text',   @_) }
1371sub cmd_item_block  { my $self = shift; $self->item_common ('block',  @_) }
1372
1373##############################################################################
1374# Backward compatibility
1375##############################################################################
1376
1377# Reset the underlying Pod::Simple object between calls to parse_from_file so
1378# that the same object can be reused to convert multiple pages.
1379sub parse_from_file {
1380    my $self = shift;
1381    $self->reinit;
1382
1383    # Fake the old cutting option to Pod::Parser.  This fiddings with internal
1384    # Pod::Simple state and is quite ugly; we need a better approach.
1385    if (ref ($_[0]) eq 'HASH') {
1386        my $opts = shift @_;
1387        if (defined ($$opts{-cutting}) && !$$opts{-cutting}) {
1388            $$self{in_pod} = 1;
1389            $$self{last_was_blank} = 1;
1390        }
1391    }
1392
1393    # Do the work.
1394    my $retval = $self->SUPER::parse_from_file (@_);
1395
1396    # Flush output, since Pod::Simple doesn't do this.  Ideally we should also
1397    # close the file descriptor if we had to open one, but we can't easily
1398    # figure this out.
1399    my $fh = $self->output_fh ();
1400    my $oldfh = select $fh;
1401    my $oldflush = $|;
1402    $| = 1;
1403    print $fh '';
1404    $| = $oldflush;
1405    select $oldfh;
1406    return $retval;
1407}
1408
1409# Pod::Simple failed to provide this backward compatibility function, so
1410# implement it ourselves.  File handles are one of the inputs that
1411# parse_from_file supports.
1412sub parse_from_filehandle {
1413    my $self = shift;
1414    return $self->parse_from_file (@_);
1415}
1416
1417# Pod::Simple's parse_file doesn't set output_fh.  Wrap the call and do so
1418# ourself unless it was already set by the caller, since our documentation has
1419# always said that this should work.
1420sub parse_file {
1421    my ($self, $in) = @_;
1422    unless (defined $$self{output_fh}) {
1423        $self->output_fh (\*STDOUT);
1424    }
1425    return $self->SUPER::parse_file ($in);
1426}
1427
1428# Do the same for parse_lines, just to be polite.  Pod::Simple's man page
1429# implies that the caller is responsible for setting this, but I don't see any
1430# reason not to set a default.
1431sub parse_lines {
1432    my ($self, @lines) = @_;
1433    unless (defined $$self{output_fh}) {
1434        $self->output_fh (\*STDOUT);
1435    }
1436    return $self->SUPER::parse_lines (@lines);
1437}
1438
1439# Likewise for parse_string_document.
1440sub parse_string_document {
1441    my ($self, $doc) = @_;
1442    unless (defined $$self{output_fh}) {
1443        $self->output_fh (\*STDOUT);
1444    }
1445    return $self->SUPER::parse_string_document ($doc);
1446}
1447
1448##############################################################################
1449# Translation tables
1450##############################################################################
1451
1452# The following table is adapted from Tom Christiansen's pod2man.  It assumes
1453# that the standard preamble has already been printed, since that's what
1454# defines all of the accent marks.  We really want to do something better than
1455# this when *roff actually supports other character sets itself, since these
1456# results are pretty poor.
1457#
1458# This only works in an ASCII world.  What to do in a non-ASCII world is very
1459# unclear -- hopefully we can assume UTF-8 and just leave well enough alone.
1460@ESCAPES{0xA0 .. 0xFF} = (
1461    "\\ ", undef, undef, undef,            undef, undef, undef, undef,
1462    undef, undef, undef, undef,            undef, "\\%", undef, undef,
1463
1464    undef, undef, undef, undef,            undef, undef, undef, undef,
1465    undef, undef, undef, undef,            undef, undef, undef, undef,
1466
1467    "A\\*`",  "A\\*'", "A\\*^", "A\\*~",   "A\\*:", "A\\*o", "\\*(Ae", "C\\*,",
1468    "E\\*`",  "E\\*'", "E\\*^", "E\\*:",   "I\\*`", "I\\*'", "I\\*^",  "I\\*:",
1469
1470    "\\*(D-", "N\\*~", "O\\*`", "O\\*'",   "O\\*^", "O\\*~", "O\\*:",  undef,
1471    "O\\*/",  "U\\*`", "U\\*'", "U\\*^",   "U\\*:", "Y\\*'", "\\*(Th", "\\*8",
1472
1473    "a\\*`",  "a\\*'", "a\\*^", "a\\*~",   "a\\*:", "a\\*o", "\\*(ae", "c\\*,",
1474    "e\\*`",  "e\\*'", "e\\*^", "e\\*:",   "i\\*`", "i\\*'", "i\\*^",  "i\\*:",
1475
1476    "\\*(d-", "n\\*~", "o\\*`", "o\\*'",   "o\\*^", "o\\*~", "o\\*:",  undef,
1477    "o\\*/" , "u\\*`", "u\\*'", "u\\*^",   "u\\*:", "y\\*'", "\\*(th", "y\\*:",
1478) if ASCII;
1479
1480##############################################################################
1481# Premable
1482##############################################################################
1483
1484# The following is the static preamble which starts all *roff output we
1485# generate.  Most is static except for the font to use as a fixed-width font,
1486# which is designed by @CFONT@, and the left and right quotes to use for C<>
1487# text, designated by @LQOUTE@ and @RQUOTE@.  However, the second part, which
1488# defines the accent marks, is only used if $escapes is set to true.
1489sub preamble_template {
1490    my ($self, $accents) = @_;
1491    my $preamble = <<'----END OF PREAMBLE----';
1492.de Sp \" Vertical space (when we can't use .PP)
1493.if t .sp .5v
1494.if n .sp
1495..
1496.de Vb \" Begin verbatim text
1497.ft @CFONT@
1498.nf
1499.ne \\$1
1500..
1501.de Ve \" End verbatim text
1502.ft R
1503.fi
1504..
1505.\" Set up some character translations and predefined strings.  \*(-- will
1506.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
1507.\" double quote, and \*(R" will give a right double quote.  \*(C+ will
1508.\" give a nicer C++.  Capital omega is used to do unbreakable dashes and
1509.\" therefore won't be available.  \*(C` and \*(C' expand to `' in nroff,
1510.\" nothing in troff, for use with C<>.
1511.tr \(*W-
1512.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
1513.ie n \{\
1514.    ds -- \(*W-
1515.    ds PI pi
1516.    if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
1517.    if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\"  diablo 12 pitch
1518.    ds L" ""
1519.    ds R" ""
1520.    ds C` @LQUOTE@
1521.    ds C' @RQUOTE@
1522'br\}
1523.el\{\
1524.    ds -- \|\(em\|
1525.    ds PI \(*p
1526.    ds L" ``
1527.    ds R" ''
1528.    ds C`
1529.    ds C'
1530'br\}
1531.\"
1532.\" Escape single quotes in literal strings from groff's Unicode transform.
1533.ie \n(.g .ds Aq \(aq
1534.el       .ds Aq '
1535.\"
1536.\" If the F register is >0, we'll generate index entries on stderr for
1537.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
1538.\" entries marked with X<> in POD.  Of course, you'll have to process the
1539.\" output yourself in some meaningful fashion.
1540.\"
1541.\" Avoid warning from groff about undefined register 'F'.
1542.de IX
1543..
1544.if !\nF .nr F 0
1545.if \nF>0 \{\
1546.    de IX
1547.    tm Index:\\$1\t\\n%\t"\\$2"
1548..
1549.    if !\nF==2 \{\
1550.        nr % 0
1551.        nr F 2
1552.    \}
1553.\}
1554----END OF PREAMBLE----
1555#'# for cperl-mode
1556
1557    if ($accents) {
1558        $preamble .= <<'----END OF PREAMBLE----'
1559.\"
1560.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
1561.\" Fear.  Run.  Save yourself.  No user-serviceable parts.
1562.    \" fudge factors for nroff and troff
1563.if n \{\
1564.    ds #H 0
1565.    ds #V .8m
1566.    ds #F .3m
1567.    ds #[ \f1
1568.    ds #] \fP
1569.\}
1570.if t \{\
1571.    ds #H ((1u-(\\\\n(.fu%2u))*.13m)
1572.    ds #V .6m
1573.    ds #F 0
1574.    ds #[ \&
1575.    ds #] \&
1576.\}
1577.    \" simple accents for nroff and troff
1578.if n \{\
1579.    ds ' \&
1580.    ds ` \&
1581.    ds ^ \&
1582.    ds , \&
1583.    ds ~ ~
1584.    ds /
1585.\}
1586.if t \{\
1587.    ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
1588.    ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
1589.    ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
1590.    ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
1591.    ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
1592.    ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
1593.\}
1594.    \" troff and (daisy-wheel) nroff accents
1595.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
1596.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
1597.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
1598.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
1599.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
1600.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
1601.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
1602.ds ae a\h'-(\w'a'u*4/10)'e
1603.ds Ae A\h'-(\w'A'u*4/10)'E
1604.    \" corrections for vroff
1605.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
1606.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
1607.    \" for low resolution devices (crt and lpr)
1608.if \n(.H>23 .if \n(.V>19 \
1609\{\
1610.    ds : e
1611.    ds 8 ss
1612.    ds o a
1613.    ds d- d\h'-1'\(ga
1614.    ds D- D\h'-1'\(hy
1615.    ds th \o'bp'
1616.    ds Th \o'LP'
1617.    ds ae ae
1618.    ds Ae AE
1619.\}
1620.rm #[ #] #H #V #F C
1621----END OF PREAMBLE----
1622#`# for cperl-mode
1623    }
1624    return $preamble;
1625}
1626
1627##############################################################################
1628# Module return value and documentation
1629##############################################################################
1630
16311;
1632__END__
1633
1634=for stopwords
1635en em ALLCAPS teeny fixedbold fixeditalic fixedbolditalic stderr utf8
1636UTF-8 Allbery Sean Burke Ossanna Solaris formatters troff uppercased
1637Christiansen nourls parsers Kernighan
1638
1639=head1 NAME
1640
1641Pod::Man - Convert POD data to formatted *roff input
1642
1643=head1 SYNOPSIS
1644
1645    use Pod::Man;
1646    my $parser = Pod::Man->new (release => $VERSION, section => 8);
1647
1648    # Read POD from STDIN and write to STDOUT.
1649    $parser->parse_file (\*STDIN);
1650
1651    # Read POD from file.pod and write to file.1.
1652    $parser->parse_from_file ('file.pod', 'file.1');
1653
1654=head1 DESCRIPTION
1655
1656Pod::Man is a module to convert documentation in the POD format (the
1657preferred language for documenting Perl) into *roff input using the man
1658macro set.  The resulting *roff code is suitable for display on a terminal
1659using L<nroff(1)>, normally via L<man(1)>, or printing using L<troff(1)>.
1660It is conventionally invoked using the driver script B<pod2man>, but it can
1661also be used directly.
1662
1663As a derived class from Pod::Simple, Pod::Man supports the same methods and
1664interfaces.  See L<Pod::Simple> for all the details.
1665
1666new() can take options, in the form of key/value pairs that control the
1667behavior of the parser.  See below for details.
1668
1669If no options are given, Pod::Man uses the name of the input file with any
1670trailing C<.pod>, C<.pm>, or C<.pl> stripped as the man page title, to
1671section 1 unless the file ended in C<.pm> in which case it defaults to
1672section 3, to a centered title of "User Contributed Perl Documentation", to
1673a centered footer of the Perl version it is run with, and to a left-hand
1674footer of the modification date of its input (or the current date if given
1675C<STDIN> for input).
1676
1677Pod::Man assumes that your *roff formatters have a fixed-width font named
1678C<CW>.  If yours is called something else (like C<CR>), use the C<fixed>
1679option to specify it.  This generally only matters for troff output for
1680printing.  Similarly, you can set the fonts used for bold, italic, and
1681bold italic fixed-width output.
1682
1683Besides the obvious pod conversions, Pod::Man also takes care of
1684formatting func(), func(3), and simple variable references like $foo or
1685@bar so you don't have to use code escapes for them; complex expressions
1686like C<$fred{'stuff'}> will still need to be escaped, though.  It also
1687translates dashes that aren't used as hyphens into en dashes, makes long
1688dashes--like this--into proper em dashes, fixes "paired quotes," makes C++
1689look right, puts a little space between double underscores, makes ALLCAPS
1690a teeny bit smaller in B<troff>, and escapes stuff that *roff treats as
1691special so that you don't have to.
1692
1693The recognized options to new() are as follows.  All options take a single
1694argument.
1695
1696=over 4
1697
1698=item center
1699
1700Sets the centered page header for the C<.TH> macro.  The default, if this
1701option is not specified, is "User Contributed Perl Documentation".
1702
1703=item date
1704
1705Sets the left-hand footer for the C<.TH> macro.  If this option is not set,
1706the contents of the environment variable POD_MAN_DATE, if set, will be used.
1707Failing that, the value of SOURCE_DATE_EPOCH, the modification date of the
1708input file, or the current time if stat() can't find that file (which will be
1709the case if the input is from C<STDIN>) will be used.  If obtained from the
1710file modification date or the current time, the date will be formatted as
1711C<YYYY-MM-DD> and will be based on UTC (so that the output will be
1712reproducible regardless of local time zone).
1713
1714=item errors
1715
1716How to report errors.  C<die> says to throw an exception on any POD
1717formatting error.  C<stderr> says to report errors on standard error, but
1718not to throw an exception.  C<pod> says to include a POD ERRORS section
1719in the resulting documentation summarizing the errors.  C<none> ignores
1720POD errors entirely, as much as possible.
1721
1722The default is C<pod>.
1723
1724=item fixed
1725
1726The fixed-width font to use for verbatim text and code.  Defaults to
1727C<CW>.  Some systems may want C<CR> instead.  Only matters for B<troff>
1728output.
1729
1730=item fixedbold
1731
1732Bold version of the fixed-width font.  Defaults to C<CB>.  Only matters
1733for B<troff> output.
1734
1735=item fixeditalic
1736
1737Italic version of the fixed-width font (actually, something of a misnomer,
1738since most fixed-width fonts only have an oblique version, not an italic
1739version).  Defaults to C<CI>.  Only matters for B<troff> output.
1740
1741=item fixedbolditalic
1742
1743Bold italic (probably actually oblique) version of the fixed-width font.
1744Pod::Man doesn't assume you have this, and defaults to C<CB>.  Some
1745systems (such as Solaris) have this font available as C<CX>.  Only matters
1746for B<troff> output.
1747
1748=item name
1749
1750Set the name of the manual page for the C<.TH> macro.  Without this
1751option, the manual name is set to the uppercased base name of the file
1752being converted unless the manual section is 3, in which case the path is
1753parsed to see if it is a Perl module path.  If it is, a path like
1754C<.../lib/Pod/Man.pm> is converted into a name like C<Pod::Man>.  This
1755option, if given, overrides any automatic determination of the name.
1756
1757If generating a manual page from standard input, this option is required,
1758since there's otherwise no way for Pod::Man to know what to use for the
1759manual page name.
1760
1761=item nourls
1762
1763Normally, LZ<><> formatting codes with a URL but anchor text are formatted
1764to show both the anchor text and the URL.  In other words:
1765
1766    L<foo|http://example.com/>
1767
1768is formatted as:
1769
1770    foo <http://example.com/>
1771
1772This option, if set to a true value, suppresses the URL when anchor text
1773is given, so this example would be formatted as just C<foo>.  This can
1774produce less cluttered output in cases where the URLs are not particularly
1775important.
1776
1777=item quotes
1778
1779Sets the quote marks used to surround CE<lt>> text.  If the value is a
1780single character, it is used as both the left and right quote.  Otherwise,
1781it is split in half, and the first half of the string is used as the left
1782quote and the second is used as the right quote.
1783
1784This may also be set to the special value C<none>, in which case no quote
1785marks are added around CE<lt>> text (but the font is still changed for troff
1786output).
1787
1788=item release
1789
1790Set the centered footer for the C<.TH> macro.  By default, this is set to
1791the version of Perl you run Pod::Man under.  Setting this to the empty
1792string will cause some *roff implementations to use the system default
1793value.
1794
1795Note that some system C<an> macro sets assume that the centered footer
1796will be a modification date and will prepend something like "Last
1797modified: ".  If this is the case for your target system, you may want to
1798set C<release> to the last modified date and C<date> to the version
1799number.
1800
1801=item section
1802
1803Set the section for the C<.TH> macro.  The standard section numbering
1804convention is to use 1 for user commands, 2 for system calls, 3 for
1805functions, 4 for devices, 5 for file formats, 6 for games, 7 for
1806miscellaneous information, and 8 for administrator commands.  There is a lot
1807of variation here, however; some systems (like Solaris) use 4 for file
1808formats, 5 for miscellaneous information, and 7 for devices.  Still others
1809use 1m instead of 8, or some mix of both.  About the only section numbers
1810that are reliably consistent are 1, 2, and 3.
1811
1812By default, section 1 will be used unless the file ends in C<.pm> in which
1813case section 3 will be selected.
1814
1815=item stderr
1816
1817Send error messages about invalid POD to standard error instead of
1818appending a POD ERRORS section to the generated *roff output.  This is
1819equivalent to setting C<errors> to C<stderr> if C<errors> is not already
1820set.  It is supported for backward compatibility.
1821
1822=item utf8
1823
1824By default, Pod::Man produces the most conservative possible *roff output
1825to try to ensure that it will work with as many different *roff
1826implementations as possible.  Many *roff implementations cannot handle
1827non-ASCII characters, so this means all non-ASCII characters are converted
1828either to a *roff escape sequence that tries to create a properly accented
1829character (at least for troff output) or to C<X>.
1830
1831If this option is set, Pod::Man will instead output UTF-8.  If your *roff
1832implementation can handle it, this is the best output format to use and
1833avoids corruption of documents containing non-ASCII characters.  However,
1834be warned that *roff source with literal UTF-8 characters is not supported
1835by many implementations and may even result in segfaults and other bad
1836behavior.
1837
1838Be aware that, when using this option, the input encoding of your POD
1839source should be properly declared unless it's US-ASCII.  Pod::Simple will
1840attempt to guess the encoding and may be successful if it's Latin-1 or
1841UTF-8, but it will produce warnings.  Use the C<=encoding> command to
1842declare the encoding.  See L<perlpod(1)> for more information.
1843
1844=back
1845
1846The standard Pod::Simple method parse_file() takes one argument naming the
1847POD file to read from.  By default, the output is sent to C<STDOUT>, but
1848this can be changed with the output_fh() method.
1849
1850The standard Pod::Simple method parse_from_file() takes up to two
1851arguments, the first being the input file to read POD from and the second
1852being the file to write the formatted output to.
1853
1854You can also call parse_lines() to parse an array of lines or
1855parse_string_document() to parse a document already in memory.  As with
1856parse_file(), parse_lines() and parse_string_document() default to sending
1857their output to C<STDOUT> unless changed with the output_fh() method.
1858
1859To put the output from any parse method into a string instead of a file
1860handle, call the output_string() method instead of output_fh().
1861
1862See L<Pod::Simple> for more specific details on the methods available to
1863all derived parsers.
1864
1865=head1 DIAGNOSTICS
1866
1867=over 4
1868
1869=item roff font should be 1 or 2 chars, not "%s"
1870
1871(F) You specified a *roff font (using C<fixed>, C<fixedbold>, etc.) that
1872wasn't either one or two characters.  Pod::Man doesn't support *roff fonts
1873longer than two characters, although some *roff extensions do (the
1874canonical versions of B<nroff> and B<troff> don't either).
1875
1876=item Invalid errors setting "%s"
1877
1878(F) The C<errors> parameter to the constructor was set to an unknown value.
1879
1880=item Invalid quote specification "%s"
1881
1882(F) The quote specification given (the C<quotes> option to the
1883constructor) was invalid.  A quote specification must be either one
1884character long or an even number (greater than one) characters long.
1885
1886=item POD document had syntax errors
1887
1888(F) The POD document being formatted had syntax errors and the C<errors>
1889option was set to C<die>.
1890
1891=back
1892
1893=head1 ENVIRONMENT
1894
1895=over 4
1896
1897=item PERL_CORE
1898
1899If set and Encode is not available, silently fall back to non-UTF-8 mode
1900without complaining to standard error.  This environment variable is set
1901during Perl core builds, which build Encode after podlators.  Encode is
1902expected to not (yet) be available in that case.
1903
1904=item POD_MAN_DATE
1905
1906If set, this will be used as the value of the left-hand footer unless the
1907C<date> option is explicitly set, overriding the timestamp of the input
1908file or the current time.  This is primarily useful to ensure reproducible
1909builds of the same output file given the same source and Pod::Man version,
1910even when file timestamps may not be consistent.
1911
1912=item SOURCE_DATE_EPOCH
1913
1914If set, and POD_MAN_DATE and the C<date> options are not set, this will be
1915used as the modification time of the source file, overriding the timestamp of
1916the input file or the current time.  It should be set to the desired time in
1917seconds since UNIX epoch.  This is primarily useful to ensure reproducible
1918builds of the same output file given the same source and Pod::Man version,
1919even when file timestamps may not be consistent.  See
1920L<https://reproducible-builds.org/specs/source-date-epoch/> for the full
1921specification.
1922
1923(Arguably, according to the specification, this variable should be used only
1924if the timestamp of the input file is not available and Pod::Man uses the
1925current time.  However, for reproducible builds in Debian, results were more
1926reliable if this variable overrode the timestamp of the input file.)
1927
1928=back
1929
1930=head1 BUGS
1931
1932Encoding handling assumes that PerlIO is available and does not work
1933properly if it isn't.  The C<utf8> option is therefore not supported
1934unless Perl is built with PerlIO support.
1935
1936There is currently no way to turn off the guesswork that tries to format
1937unmarked text appropriately, and sometimes it isn't wanted (particularly
1938when using POD to document something other than Perl).  Most of the work
1939toward fixing this has now been done, however, and all that's still needed
1940is a user interface.
1941
1942The NAME section should be recognized specially and index entries emitted
1943for everything in that section.  This would have to be deferred until the
1944next section, since extraneous things in NAME tends to confuse various man
1945page processors.  Currently, no index entries are emitted for anything in
1946NAME.
1947
1948Pod::Man doesn't handle font names longer than two characters.  Neither do
1949most B<troff> implementations, but GNU troff does as an extension.  It would
1950be nice to support as an option for those who want to use it.
1951
1952The preamble added to each output file is rather verbose, and most of it
1953is only necessary in the presence of non-ASCII characters.  It would
1954ideally be nice if all of those definitions were only output if needed,
1955perhaps on the fly as the characters are used.
1956
1957Pod::Man is excessively slow.
1958
1959=head1 CAVEATS
1960
1961If Pod::Man is given the C<utf8> option, the encoding of its output file
1962handle will be forced to UTF-8 if possible, overriding any existing
1963encoding.  This will be done even if the file handle is not created by
1964Pod::Man and was passed in from outside.  This maintains consistency
1965regardless of PERL_UNICODE and other settings.
1966
1967The handling of hyphens and em dashes is somewhat fragile, and one may get
1968the wrong one under some circumstances.  This should only matter for
1969B<troff> output.
1970
1971When and whether to use small caps is somewhat tricky, and Pod::Man doesn't
1972necessarily get it right.
1973
1974Converting neutral double quotes to properly matched double quotes doesn't
1975work unless there are no formatting codes between the quote marks.  This
1976only matters for troff output.
1977
1978=head1 AUTHOR
1979
1980Russ Allbery <rra@cpan.org>, based I<very> heavily on the original
1981B<pod2man> by Tom Christiansen <tchrist@mox.perl.com>.  The modifications to
1982work with Pod::Simple instead of Pod::Parser were originally contributed by
1983Sean Burke (but I've since hacked them beyond recognition and all bugs are
1984mine).
1985
1986=head1 COPYRIGHT AND LICENSE
1987
1988Copyright 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
19892009, 2010, 2012, 2013, 2014, 2015, 2016 Russ Allbery <rra@cpan.org>
1990
1991This program is free software; you may redistribute it and/or modify it
1992under the same terms as Perl itself.
1993
1994=head1 SEE ALSO
1995
1996L<Pod::Simple>, L<perlpod(1)>, L<pod2man(1)>, L<nroff(1)>, L<troff(1)>,
1997L<man(1)>, L<man(7)>
1998
1999Ossanna, Joseph F., and Brian W. Kernighan.  "Troff User's Manual,"
2000Computing Science Technical Report No. 54, AT&T Bell Laboratories.  This is
2001the best documentation of standard B<nroff> and B<troff>.  At the time of
2002this writing, it's available at
2003L<http://www.cs.bell-labs.com/cm/cs/cstr.html>.
2004
2005The man page documenting the man macro set may be L<man(5)> instead of
2006L<man(7)> on your system.  Also, please see L<pod2man(1)> for extensive
2007documentation on writing manual pages if you've not done it before and
2008aren't familiar with the conventions.
2009
2010The current version of this module is always available from its web site at
2011L<http://www.eyrie.org/~eagle/software/podlators/>.  It is also part of the
2012Perl core distribution as of 5.6.0.
2013
2014=cut
2015