parser.pm

mrtg 监控,请认真阅读您的文件包然后写出其具体功能

where C<$parser> is a reference to the parser object, C<$text> is the
text-string encountered, and C<$ptree_node> is a reference to the current
node in the parse-tree (usually an interior-sequence object or else the
top-level node of the parse-tree).

=item B<-expand_ptree> =E<gt> I<code-ref>|I<method-name>

Rather than returning a C<Pod::ParseTree>, pass the parse-tree as an
argument to the referenced subroutine (or named method of the parser
object) and return the result instead of the parse-tree object.

If a subroutine reference was given, it is invoked as:

  &$code_ref( $parser, $ptree )

and if a method-name was given, it is invoked as:

  $parser->method_name( $ptree )

where C<$parser> is a reference to the parser object, and C<$ptree>
is a reference to the parse-tree object.

=back

=cut

sub parse_text {
    my $self = shift;
    local $_ = '';

    ## Get options and set any defaults
    my %opts = (ref $_[0]) ? %{ shift() } : ();
    my $expand_seq   = $opts{'-expand_seq'}   || undef;
    my $expand_text  = $opts{'-expand_text'}  || undef;
    my $expand_ptree = $opts{'-expand_ptree'} || undef;

    my $text = shift;
    my $line = shift;
    my $file = $self->input_file();
    my $cmd  = "";

    ## Convert method calls into closures, for our convenience
    my $xseq_sub   = $expand_seq;
    my $xtext_sub  = $expand_text;
    my $xptree_sub = $expand_ptree;
    if (defined $expand_seq  and  $expand_seq eq 'interior_sequence') {
        ## If 'interior_sequence' is the method to use, we have to pass
        ## more than just the sequence object, we also need to pass the
        ## sequence name and text.
        $xseq_sub = sub {
            my ($self, $iseq) = @_;
            my $args = join("", $iseq->parse_tree->children);
            return  $self->interior_sequence($iseq->name, $args, $iseq);
        };
    }
    ref $xseq_sub    or  $xseq_sub   = sub { shift()->$expand_seq(@_) };
    ref $xtext_sub   or  $xtext_sub  = sub { shift()->$expand_text(@_) };
    ref $xptree_sub  or  $xptree_sub = sub { shift()->$expand_ptree(@_) };

    ## Keep track of the "current" interior sequence, and maintain a stack
    ## of "in progress" sequences.
    ##
    ## NOTE that we push our own "accumulator" at the very beginning of the
    ## stack. It's really a parse-tree, not a sequence; but it implements
    ## the methods we need so we can use it to gather-up all the sequences
    ## and strings we parse. Thus, by the end of our parsing, it should be
    ## the only thing left on our stack and all we have to do is return it!
    ##
    my $seq       = Pod::ParseTree->new();
    my @seq_stack = ($seq);
    my ($ldelim, $rdelim) = ('', '');

    ## Iterate over all sequence starts text (NOTE: split with
    ## capturing parens keeps the delimiters)
    $_ = $text;
    my @tokens = split /([A-Z]<(?:<+\s+)?)/;
    while ( @tokens ) {
        $_ = shift @tokens;
        ## Look for the beginning of a sequence
        if ( /^([A-Z])(<(?:<+\s+)?)$/ ) {
            ## Push a new sequence onto the stack of those "in-progress"
            ($cmd, $ldelim) = ($1, $2);
            $seq = Pod::InteriorSequence->new(
                       -name   => $cmd,
                       -ldelim => $ldelim,  -rdelim => '',
                       -file   => $file,    -line   => $line
                   );
            $ldelim =~ s/\s+$//, ($rdelim = $ldelim) =~ tr/</>/;
            (@seq_stack > 1)  and  $seq->nested($seq_stack[-1]);
            push @seq_stack, $seq;
        }
        ## Look for sequence ending
        elsif ( @seq_stack > 1 ) {
            ## Make sure we match the right kind of closing delimiter
            my ($seq_end, $post_seq) = ("", "");
            if ( ($ldelim eq '<'   and  /\A(.*?)(>)/s)
                 or  /\A(.*?)(\s+$rdelim)/s )
            {
                ## Found end-of-sequence, capture the interior and the
                ## closing the delimiter, and put the rest back on the
                ## token-list
                $post_seq = substr($_, length($1) + length($2));
                ($_, $seq_end) = ($1, $2);
                (length $post_seq)  and  unshift @tokens, $post_seq;
            }
            if (length) {
                ## In the middle of a sequence, append this text to it, and
                ## dont forget to "expand" it if that's what the caller wanted
                $seq->append($expand_text ? &$xtext_sub($self,$_,$seq) : $_);
                $_ .= $seq_end;
            }
            if (length $seq_end) {
                ## End of current sequence, record terminating delimiter
                $seq->rdelim($seq_end);
                ## Pop it off the stack of "in progress" sequences
                pop @seq_stack;
                ## Append result to its parent in current parse tree
                $seq_stack[-1]->append($expand_seq ? &$xseq_sub($self,$seq)
                                                   : $seq);
                ## Remember the current cmd-name and left-delimiter
                $cmd = (@seq_stack > 1) ? $seq_stack[-1]->name : '';
                $ldelim = (@seq_stack > 1) ? $seq_stack[-1]->ldelim : '';
                $ldelim =~ s/\s+$//, ($rdelim = $ldelim) =~ tr/</>/;
            }
        }
        elsif (length) {
            ## In the middle of a sequence, append this text to it, and
            ## dont forget to "expand" it if that's what the caller wanted
            $seq->append($expand_text ? &$xtext_sub($self,$_,$seq) : $_);
        }
        ## Keep track of line count
        $line += tr/\n//;
        ## Remember the "current" sequence
        $seq = $seq_stack[-1];
    }

    ## Handle unterminated sequences
    my $errorsub = (@seq_stack > 1) ? $self->errorsub() : undef;
    while (@seq_stack > 1) {
       ($cmd, $file, $line) = ($seq->name, $seq->file_line);
       $ldelim  = $seq->ldelim;
       ($rdelim = $ldelim) =~ tr/</>/;
       $rdelim  =~ s/^(\S+)(\s*)$/$2$1/;
       pop @seq_stack;
       my $errmsg = "*** ERROR: unterminated ${cmd}${ldelim}...${rdelim}".
                    " at line $line in file $file\n";
       (ref $errorsub) and &{$errorsub}($errmsg)
           or (defined $errorsub) and $self->$errorsub($errmsg)
               or  warn($errmsg);
       $seq_stack[-1]->append($expand_seq ? &$xseq_sub($self,$seq) : $seq);
       $seq = $seq_stack[-1];
    }

    ## Return the resulting parse-tree
    my $ptree = (pop @seq_stack)->parse_tree;
    return  $expand_ptree ? &$xptree_sub($self, $ptree) : $ptree;
}

##---------------------------------------------------------------------------

=head1 B<interpolate()>

            $textblock = $parser->interpolate($text, $line_num);

This method translates all text (including any embedded interior sequences)
in the given text string C<$text> and returns the interpolated result. The
parameter C<$line_num> is the line number corresponding to the beginning
of C<$text>.

B<interpolate()> merely invokes a private method to recursively expand
nested interior sequences in bottom-up order (innermost sequences are
expanded first). If there is a need to expand nested sequences in
some alternate order, use B<parse_text> instead.

=cut

sub interpolate {
    my($self, $text, $line_num) = @_;
    my %parse_opts = ( -expand_seq => 'interior_sequence' );
    my $ptree = $self->parse_text( \%parse_opts, $text, $line_num );
    return  join "", $ptree->children();
}

##---------------------------------------------------------------------------

=begin __PRIVATE__

=head1 B<parse_paragraph()>

            $parser->parse_paragraph($text, $line_num);

This method takes the text of a POD paragraph to be processed, along
with its corresponding line number, and invokes the appropriate method
(one of B<command()>, B<verbatim()>, or B<textblock()>).

For performance reasons, this method is invoked directly without any
dynamic lookup; Hence subclasses may I<not> override it!

=end __PRIVATE__

=cut

sub parse_paragraph {
    my ($self, $text, $line_num) = @_;
    local *myData = $self;  ## alias to avoid deref-ing overhead
    local *myOpts = ($myData{_PARSEOPTS} ||= {});  ## get parse-options
    local $_;

    ## See if we want to preprocess nonPOD paragraphs as well as POD ones.
    my $wantNonPods = $myOpts{'-want_nonPODs'};

    ## Update cutting status
    $myData{_CUTTING} = 0 if $text =~ /^={1,2}\S/;

    ## Perform any desired preprocessing if we wanted it this early
    $wantNonPods  and  $text = $self->preprocess_paragraph($text, $line_num);

    ## Ignore up until next POD directive if we are cutting
    return if $myData{_CUTTING};

    ## Now we know this is block of text in a POD section!

    ##-----------------------------------------------------------------
    ## This is a hook (hack ;-) for Pod::Select to do its thing without
    ## having to override methods, but also without Pod::Parser assuming
    ## $self is an instance of Pod::Select (if the _SELECTED_SECTIONS
    ## field exists then we assume there is an is_selected() method for
    ## us to invoke (calling $self->can('is_selected') could verify this
    ## but that is more overhead than I want to incur)
    ##-----------------------------------------------------------------

    ## Ignore this block if it isnt in one of the selected sections
    if (exists $myData{_SELECTED_SECTIONS}) {
        $self->is_selected($text)  or  return ($myData{_CUTTING} = 1);
    }

    ## If we havent already, perform any desired preprocessing and
    ## then re-check the "cutting" state
    unless ($wantNonPods) {
       $text = $self->preprocess_paragraph($text, $line_num);
       return 1  unless ((defined $text) and (length $text));
       return 1  if ($myData{_CUTTING});
    }

    ## Look for one of the three types of paragraphs
    my ($pfx, $cmd, $arg, $sep) = ('', '', '', '');
    my $pod_para = undef;
    if ($text =~ /^(={1,2})(?=\S)/) {
        ## Looks like a command paragraph. Capture the command prefix used
        ## ("=" or "=="), as well as the command-name, its paragraph text,
        ## and whatever sequence of characters was used to separate them
        $pfx = $1;
        $_ = substr($text, length $pfx);
        ($cmd, $sep, $text) = split /(\s+)/, $_, 2; 
        ## If this is a "cut" directive then we dont need to do anything
        ## except return to "cutting" mode.
        if ($cmd eq 'cut') {
           $myData{_CUTTING} = 1;
           return  unless $myOpts{'-process_cut_cmd'};
        }
    }
    ## Save the attributes indicating how the command was specified.
    $pod_para = new Pod::Paragraph(
          -name      => $cmd,
          -text      => $text,
          -prefix    => $pfx,
          -separator => $sep,
          -file      => $myData{_INFILE},
          -line      => $line_num
    );
    # ## Invoke appropriate callbacks
    # if (exists $myData{_CALLBACKS}) {
    #    ## Look through the callback list, invoke callbacks,
    #    ## then see if we need to do the default actions
    #    ## (invoke_callbacks will return true if we do).
    #    return  1  unless $self->invoke_callbacks($cmd, $text, $line_num, $pod_para);
    # }
    if (length $cmd) {
        ## A command paragraph
        $self->command($cmd, $text, $line_num, $pod_para);
    }
    elsif ($text =~ /^\s+/) {
        ## Indented text - must be a verbatim paragraph
        $self->verbatim($text, $line_num, $pod_para);
    }
    else {
        ## Looks like an ordinary block of text
        $self->textblock($text, $line_num, $pod_para);
    }
    return  1;
}

##---------------------------------------------------------------------------

=head1 B<parse_from_filehandle()>

            $parser->parse_from_filehandle($in_fh,$out_fh);

This method takes an input filehandle (which is assumed to already be
opened for reading) and reads the entire input stream looking for blocks
(paragraphs) of POD documentation to be processed. If no first argument
is given the default input filehandle C<STDIN> is used.

The C<$in_fh> parameter may be any object that provides a B<getline()>
method to retrieve a single line of input text (hence, an appropriate
wrapper object could be used to parse PODs from a single string or an
array of strings).

Using C<$in_fh-E<gt>getline()>, input is read line-by-line and assembled
into paragraphs or "blocks" (which are separated by lines containing
nothing but whitespace). For each block of POD documentation
encountered it will invoke a method to parse the given paragraph.

If a second argument is given then it should correspond to a filehandle where
output should be sent (otherwise the default output filehandle is
C<STDOUT> if no output filehandle is currently in use).

B<NOTE:> For performance reasons, this method caches the input stream at
the top of the stack in a local variable. Any attempts by clients to
change the stack contents during processing when in the midst executing
of this method I<will not affect> the input stream used by the current
invocation of this method.

This method does I<not> usually need to be overridden by subclasses.

=cut

sub parse_from_filehandle {
    my $self = shift;
    my %opts = (ref $_[0] eq 'HASH') ? %{ shift() } : ();
    my ($in_fh, $out_fh) = @_;
    $in_fh = \*STDIN  unless ($in_fh);
    local *myData = $self;  ## alias to avoid deref-ing overhead
    local *myOpts = ($myData{_PARSEOPTS} ||= {});  ## get parse-options
    local $_;

    ## Put this stream at the top of the stack and do beginning-of-input
    ## processing. NOTE that $in_fh might be reset during this process.
    my $topstream = $self->_push_input_stream($in_fh, $out_fh);
    (exists $opts{-cutting})  and  $self->cutting( $opts{-cutting} );

    ## Initialize line/paragraph
    my ($textline, $paragraph) = ('', '');
    my ($nlines, $plines) = (0, 0);

    ## Use <$fh> instead of $fh->getline where possible (for speed)
    $_ = ref $in_fh;
    my $tied_fh = (/^(?:GLOB|FileHandle|IO::\w+)$/  or  tied $in_fh);

    ## Read paragraphs line-by-line
    while (defined ($textline = $tied_fh ? <$in_fh> : $in_fh->getline)) {
        $textline = $self->preprocess_line($textline, ++$nlines);
        next  unless ((defined $textline)  &&  (length $textline));