man.pm

UNIX下perl实现代码

    }

    # Figure out what quotes we'll be using for C<> text.
    $$self{quotes} ||= '"';
    if ($$self{quotes} eq 'none') {
        $$self{LQUOTE} = $$self{RQUOTE} = '';
    } elsif (length ($$self{quotes}) == 1) {
        $$self{LQUOTE} = $$self{RQUOTE} = $$self{quotes};
    } elsif ($$self{quotes} =~ /^(.)(.)$/
             || $$self{quotes} =~ /^(..)(..)$/) {
        $$self{LQUOTE} = $1;
        $$self{RQUOTE} = $2;
    } else {
        croak qq(Invalid quote specification "$$self{quotes}");
    }

    # Double the first quote; note that this should not be s///g as two
    # double quotes is represented in *roff as three double quotes, not
    # four.  Weird, I know.
    $$self{LQUOTE} =~ s/\"/\"\"/;
    $$self{RQUOTE} =~ s/\"/\"\"/;

    $$self{INDENT}  = 0;        # Current indentation level.
    $$self{INDENTS} = [];       # Stack of indentations.
    $$self{INDEX}   = [];       # Index keys waiting to be printed.
    $$self{ITEMS}   = 0;        # The number of consecutive =items.

    $self->SUPER::initialize;
}

# For each document we process, output the preamble first.
sub begin_pod {
    my $self = shift;

    # Try to figure out the name and section from the file name.
    my $section = $$self{section} || 1;
    my $name = $$self{name};
    if (!defined $name) {
        $name = $self->input_file;
        $section = 3 if (!$$self{section} && $name =~ /\.pm\z/i);
        $name =~ s/\.p(od|[lm])\z//i;
        if ($section =~ /^1/) {
            require File::Basename;
            $name = uc File::Basename::basename ($name);
        } else {
            # Lose everything up to the first of
            #     */lib/*perl*      standard or site_perl module
            #     */*perl*/lib      from -D prefix=/opt/perl
            #     */*perl*/         random module hierarchy
            # which works.  Should be fixed to use File::Spec.  Also handle
            # a leading lib/ since that's what ExtUtils::MakeMaker creates.
            for ($name) {
                s%//+%/%g;
                if (     s%^.*?/lib/[^/]*perl[^/]*/%%si
                      or s%^.*?/[^/]*perl[^/]*/(?:lib/)?%%si) {
                    s%^site(_perl)?/%%s;      # site and site_perl
                    s%^(.*-$^O|$^O-.*)/%%so;  # arch
                    s%^\d+\.\d+%%s;           # version
                }
                s%^lib/%%;
                s%/%::%g;
            }
        }
    }

    # If $name contains spaces, quote it; this mostly comes up in the case
    # of input from stdin.
    $name = '"' . $name . '"' if ($name =~ /\s/);

    # Modification date header.  Try to use the modification time of our
    # input.
    if (!defined $$self{date}) {
        my $time = (stat $self->input_file)[9] || time;
        my ($day, $month, $year) = (localtime $time)[3,4,5];
        $month++;
        $year += 1900;
        $$self{date} = sprintf ('%4d-%02d-%02d', $year, $month, $day);
    }

    # Now, print out the preamble and the title.
    local $_ = $PREAMBLE;
    s/\@CFONT\@/$$self{fixed}/;
    s/\@LQUOTE\@/$$self{LQUOTE}/;
    s/\@RQUOTE\@/$$self{RQUOTE}/;
    chomp $_;
    print { $self->output_handle } <<"----END OF HEADER----";
.\\" Automatically generated by Pod::Man version $VERSION
.\\" @{[ scalar localtime ]}
.\\"
.\\" Standard preamble:
.\\" ======================================================================
$_
.\\" ======================================================================
.\\"
.IX Title "$name $section"
.TH $name $section "$$self{release}" "$$self{date}" "$$self{center}"
.UC
----END OF HEADER----
#"# for cperl-mode

    # Initialize a few per-file variables.
    $$self{INDENT} = 0;
    $$self{NEEDSPACE} = 0;
}


############################################################################
# Core overrides
############################################################################

# Called for each command paragraph.  Gets the command, the associated
# paragraph, the line number, and a Pod::Paragraph object.  Just dispatches
# the command to a method named the same as the command.  =cut is handled
# internally by Pod::Parser.
sub command {
    my $self = shift;
    my $command = shift;
    return if $command eq 'pod';
   return if ($$self{EXCLUDE} && $command ne 'end');
    if ($self->can ('cmd_' . $command)) {
        $command = 'cmd_' . $command;
        $self->$command (@_);
     } else {
        my ($text, $line, $paragraph) = @_;
        my $file;
        ($file, $line) = $paragraph->file_line;
        $text =~ s/\n+\z//;
        $text = " $text" if ($text =~ /^\S/);
        warn qq($file:$line: Unknown command paragraph "=$command$text"\n);
        return;
    }
}

# Called for a verbatim paragraph.  Gets the paragraph, the line number, and
# a Pod::Paragraph object.  Rofficate backslashes, untabify, put a
# zero-width character at the beginning of each line to protect against
# commands, and wrap in .Vb/.Ve.
sub verbatim {
    my $self = shift;
    return if $$self{EXCLUDE};
    local $_ = shift;
    return if /^\s+$/;
    s/\s+$/\n/;
    my $lines = tr/\n/\n/;
    1 while s/^(.*?)(\t+)/$1 . ' ' x (length ($2) * 8 - length ($1) % 8)/me;
    s/\\/\\e/g;
    s/^(\s*\S)/'\&' . $1/gme;
    $self->makespace;
    $self->output (".Vb $lines\n$_.Ve\n");
    $$self{NEEDSPACE} = 0;
}

# Called for a regular text block.  Gets the paragraph, the line number, and
# a Pod::Paragraph object.  Perform interpolation and output the results.
sub textblock {
    my $self = shift;
    return if $$self{EXCLUDE};
    $self->output ($_[0]), return if $$self{VERBATIM};

    # Perform a little magic to collapse multiple L<> references.  We'll
    # just rewrite the whole thing into actual text at this part, bypassing
    # the whole internal sequence parsing thing.
    my $text = shift;
    $text =~ s{
        (L<                     # A link of the form L</something>.
              /
              (
                  [:\w]+        # The item has to be a simple word...
                  (\(\))?       # ...or simple function.
              )
          >
          (
              ,?\s+(and\s+)?    # Allow lots of them, conjuncted.
              L<
                  /
                  ( [:\w]+ ( \(\) )? )
              >
          )+
        )
    } {
        local $_ = $1;
        s{ L< / ( [^>]+ ) > } {$1}xg;
        my @items = split /(?:,?\s+(?:and\s+)?)/;
        my $string = 'the ';
        my $i;
        for ($i = 0; $i < @items; $i++) {
            $string .= $items[$i];
            $string .= ', ' if @items > 2 && $i != $#items;
            $string .= ' ' if @items == 2 && $i == 2;
            $string .= 'and ' if ($i == $#items - 1);
        }
        $string .= ' entries elsewhere in this document';
        $string;
    }gex;

    # Parse the tree and output it.  collapse knows about references to
    # scalars as well as scalars and does the right thing with them.
    $text = $self->parse ($text, @_);
    $text =~ s/\n\s*$/\n/;
    $self->makespace;
    $self->output (protect $self->textmapfonts ($text));
    $self->outindex;
    $$self{NEEDSPACE} = 1;
}

# Called for an interior sequence.  Takes a Pod::InteriorSequence object and
# returns a reference to a scalar.  This scalar is the final formatted text.
# It's returned as a reference so that other interior sequences above us
# know that the text has already been processed.
sub sequence {
    my ($self, $seq) = @_;
    my $command = $seq->cmd_name;

    # Zero-width characters.
    if ($command eq 'Z') {
        # Workaround to generate a blessable reference, needed by 5.005.
        my $tmp = '\&';
        return bless \ "$tmp", 'Pod::Man::String';
    }

    # C<>, L<>, X<>, and E<> don't apply guesswork to their contents.  C<>
    # needs some additional special handling.
    my $literal = ($command =~ /^[CELX]$/);
    $literal++ if $command eq 'C';
    local $_ = $self->collapse ($seq->parse_tree, $literal);

    # Handle E<> escapes.
    if ($command eq 'E') {
        if (/^\d+$/) {
            return bless \ chr ($_), 'Pod::Man::String';
        } elsif (exists $ESCAPES{$_}) {
            return bless \ "$ESCAPES{$_}", 'Pod::Man::String';
        } else {
            carp "Unknown escape E<$1>";
            return bless \ "E<$_>", 'Pod::Man::String';
        }
    }

    # For all the other sequences, empty content produces no output.
    return '' if $_ eq '';

    # Handle formatting sequences.
    if ($command eq 'B') {
        return bless \ ('\f(BS' . $_ . '\f(BE'), 'Pod::Man::String';
    } elsif ($command eq 'F') {
        return bless \ ('\f(IS' . $_ . '\f(IE'), 'Pod::Man::String';
    } elsif ($command eq 'I') {
        return bless \ ('\f(IS' . $_ . '\f(IE'), 'Pod::Man::String';
    } elsif ($command eq 'C') {
        return bless \ ('\f(FS\*(C`' . $_ . "\\*(C'\\f(FE"),
            'Pod::Man::String';
    }

    # Handle links.
    if ($command eq 'L') {
        # A bug in lvalue subs in 5.6 requires the temporary variable.
        my $tmp = $self->buildlink ($_);
        return bless \ "$tmp", 'Pod::Man::String';
    }

    # Whitespace protection replaces whitespace with "\ ".
    if ($command eq 'S') {
        s/\s+/\\ /g;
        return bless \ "$_", 'Pod::Man::String';
    }

    # Add an index entry to the list of ones waiting to be output.
    if ($command eq 'X') { push (@{ $$self{INDEX} }, $_); return '' }

    # Anything else is unknown.
    carp "Unknown sequence $command<$_>";
}


############################################################################
# Command paragraphs
############################################################################

# All command paragraphs take the paragraph and the line number.

# First level heading.  We can't output .IX in the NAME section due to a bug
# in some versions of catman, so don't output a .IX for that section.  .SH
# already uses small caps, so remove any E<> sequences that would cause
# them.
sub cmd_head1 {
    my $self = shift;
    local $_ = $self->parse (@_);
    s/\s+$//;
    s/\\s-?\d//g;
    s/\s*\n\s*/ /g;
    if ($$self{ITEMS} > 1) {
        $$self{ITEMS} = 0;
        $self->output (".PD\n");
    }
    $self->output ($self->switchquotes ('.SH', $self->mapfonts ($_)));
    $self->outindex (($_ eq 'NAME') ? () : ('Header', $_));
    $$self{NEEDSPACE} = 0;
}

# Second level heading.
sub cmd_head2 {
    my $self = shift;
    local $_ = $self->parse (@_);
    s/\s+$//;
    s/\s*\n\s*/ /g;
    if ($$self{ITEMS} > 1) {
        $$self{ITEMS} = 0;
        $self->output (".PD\n");
    }
    $self->output ($self->switchquotes ('.Sh', $self->mapfonts ($_)));
    $self->outindex ('Subsection', $_);
    $$self{NEEDSPACE} = 0;
}

# Third level heading.
sub cmd_head3 {
    my $self = shift;
    local $_ = $self->parse (@_);
    s/\s+$//;
    s/\s*\n\s*/ /g;
    if ($$self{ITEMS} > 1) {
        $$self{ITEMS} = 0;
        $self->output (".PD\n");
    }
    $self->makespace;
    $self->output ($self->switchquotes ('.I', $self->mapfonts ($_)));
    $self->outindex ('Subsection', $_);
    $$self{NEEDSPACE} = 1;
}

# Fourth level heading.
sub cmd_head4 {
    my $self = shift;
    local $_ = $self->parse (@_);
    s/\s+$//;
    s/\s*\n\s*/ /g;
    if ($$self{ITEMS} > 1) {
        $$self{ITEMS} = 0;
        $self->output (".PD\n");
    }
    $self->makespace;
    $self->output ($self->textmapfonts ($_) . "\n");
    $self->outindex ('Subsection', $_);
    $$self{NEEDSPACE} = 1;
}

# Start a list.  For indents after the first, wrap the outside indent in .RS