inputobjects.pm

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

       splice @_, $#_, 0, '-ptree';
    }

    ## Any remaining arguments are treated as initial values for the
    ## hash that is used to represent this object. Note that we default
    ## certain values by specifying them *before* the arguments passed.
    ## If they are in the argument list, they will override the defaults.
    my $self = {
          -name       => (@_ == 1) ? $_[0] : undef,
          -file       => '<unknown-file>',
          -line       => 0,
          -ldelim     => '<',
          -rdelim     => '>',
          @_
    };

    ## Initialize contents if they havent been already
    my $ptree = $self->{'-ptree'} || new Pod::ParseTree();
    if ( ref $ptree =~ /^(ARRAY)?$/ ) {
        ## We have an array-ref, or a normal scalar. Pass it as an
        ## an argument to the ptree-constructor
        $ptree = new Pod::ParseTree($1 ? [$ptree] : $ptree);
    }
    $self->{'-ptree'} = $ptree;

    ## Bless ourselves into the desired class and perform any initialization
    bless $self, $class;
    return $self;
}

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

=head2 $pod_seq-E<gt>B<cmd_name()>

        my $seq_cmd = $pod_seq->cmd_name();

The name of the interior sequence command.

=cut

sub cmd_name {
   (@_ > 1)  and  $_[0]->{'-name'} = $_[1];
   return $_[0]->{'-name'};
}

## let name() be an alias for cmd_name()
*name = \&cmd_name;

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

## Private subroutine to set the parent pointer of all the given
## children that are interior-sequences to be $self

sub _set_child2parent_links {
   my ($self, @children) = @_;
   ## Make sure any sequences know who their parent is
   for (@children) {
      next  unless (length  and  ref  and  ref ne 'SCALAR');
      if (UNIVERSAL::isa($_, 'Pod::InteriorSequence') or
          UNIVERSAL::can($_, 'nested'))
      {
          $_->nested($self);
      }
   }
}

## Private subroutine to unset child->parent links

sub _unset_child2parent_links {
   my $self = shift;
   $self->{'-parent_sequence'} = undef;
   my $ptree = $self->{'-ptree'};
   for (@$ptree) {
      next  unless (length  and  ref  and  ref ne 'SCALAR');
      $_->_unset_child2parent_links()
          if UNIVERSAL::isa($_, 'Pod::InteriorSequence');
   }
}

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

=head2 $pod_seq-E<gt>B<prepend()>

        $pod_seq->prepend($text);
        $pod_seq1->prepend($pod_seq2);

Prepends the given string or parse-tree or sequence object to the parse-tree
of this interior sequence.

=cut

sub prepend {
   my $self  = shift;
   $self->{'-ptree'}->prepend(@_);
   _set_child2parent_links($self, @_);
   return $self;
}       

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

=head2 $pod_seq-E<gt>B<append()>

        $pod_seq->append($text);
        $pod_seq1->append($pod_seq2);

Appends the given string or parse-tree or sequence object to the parse-tree
of this interior sequence.

=cut

sub append {
   my $self = shift;
   $self->{'-ptree'}->append(@_);
   _set_child2parent_links($self, @_);
   return $self;
}       

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

=head2 $pod_seq-E<gt>B<nested()>

        $outer_seq = $pod_seq->nested || print "not nested";

If this interior sequence is nested inside of another interior
sequence, then the outer/parent sequence that contains it is
returned. Otherwise C<undef> is returned.

=cut

sub nested {
   my $self = shift;
  (@_ == 1)  and  $self->{'-parent_sequence'} = shift;
   return  $self->{'-parent_sequence'} || undef;
}

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

=head2 $pod_seq-E<gt>B<raw_text()>

        my $seq_raw_text = $pod_seq->raw_text();

This method will return the I<raw> text of the POD interior sequence,
exactly as it appeared in the input.

=cut

sub raw_text {
   my $self = shift;
   my $text = $self->{'-name'} . $self->{'-ldelim'};
   for ( $self->{'-ptree'}->children ) {
      $text .= (ref $_) ? $_->raw_text : $_;
   }
   $text .= $self->{'-rdelim'};
   return $text;
}

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

=head2 $pod_seq-E<gt>B<left_delimiter()>

        my $ldelim = $pod_seq->left_delimiter();

The leftmost delimiter beginning the argument text to the interior
sequence (should be "<").

=cut

sub left_delimiter {
   (@_ > 1)  and  $_[0]->{'-ldelim'} = $_[1];
   return $_[0]->{'-ldelim'};
}

## let ldelim() be an alias for left_delimiter()
*ldelim = \&left_delimiter;

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

=head2 $pod_seq-E<gt>B<right_delimiter()>

The rightmost delimiter beginning the argument text to the interior
sequence (should be ">").

=cut

sub right_delimiter {
   (@_ > 1)  and  $_[0]->{'-rdelim'} = $_[1];
   return $_[0]->{'-rdelim'};
}

## let rdelim() be an alias for right_delimiter()
*rdelim = \&right_delimiter;

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

=head2 $pod_seq-E<gt>B<parse_tree()>

        my $ptree = $pod_parser->parse_text($paragraph_text);
        $pod_seq->parse_tree( $ptree );
        $ptree = $pod_seq->parse_tree();

This method will get/set the corresponding parse-tree of the interior
sequence's text.

=cut

sub parse_tree {
   (@_ > 1)  and  $_[0]->{'-ptree'} = $_[1];
   return $_[0]->{'-ptree'};
}       

## let ptree() be an alias for parse_tree()
*ptree = \&parse_tree;

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

=head2 $pod_seq-E<gt>B<file_line()>

        my ($filename, $line_number) = $pod_seq->file_line();
        my $position = $pod_seq->file_line();

Returns the current filename and line number for the interior sequence
object.  If called in an array context, it returns a list of two
elements: first the filename, then the line number. If called in
a scalar context, it returns a string containing the filename, followed
by a colon (':'), followed by the line number.

=cut

sub file_line {
   my @loc = ($_[0]->{'-file'}  || '<unknown-file>',
              $_[0]->{'-line'}  || 0);
   return (wantarray) ? @loc : join(':', @loc);
}

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

=head2 Pod::InteriorSequence::B<DESTROY()>

This method performs any necessary cleanup for the interior-sequence.
If you override this method then it is B<imperative> that you invoke
the parent method from within your own method, otherwise
I<interior-sequence storage will not be reclaimed upon destruction!>

=cut

sub DESTROY {
   ## We need to get rid of all child->parent pointers throughout the
   ## tree so their reference counts will go to zero and they can be
   ## garbage-collected
   _unset_child2parent_links(@_);
}

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

#############################################################################

package Pod::ParseTree;

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

=head1 B<Pod::ParseTree>

This object corresponds to a tree of parsed POD text. As POD text is
scanned from left to right, it is parsed into an ordered list of
text-strings and B<Pod::InteriorSequence> objects (in order of
appearance). A B<Pod::ParseTree> object corresponds to this list of
strings and sequences. Each interior sequence in the parse-tree may
itself contain a parse-tree (since interior sequences may be nested).

=cut

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

=head2 Pod::ParseTree-E<gt>B<new()>

        my $ptree1 = Pod::ParseTree->new;
        my $ptree2 = new Pod::ParseTree;
        my $ptree4 = Pod::ParseTree->new($array_ref);
        my $ptree3 = new Pod::ParseTree($array_ref);

This is a class method that constructs a C<Pod::Parse_tree> object and
returns a reference to the new parse-tree. If a single-argument is given,
it must be a reference to an array, and is used to initialize the root
(top) of the parse tree.

=cut

sub new {
    ## Determine if we were called via an object-ref or a classname
    my $this = shift;
    my $class = ref($this) || $this;

    my $self = (@_ == 1  and  ref $_[0]) ? $_[0] : [];

    ## Bless ourselves into the desired class and perform any initialization
    bless $self, $class;
    return $self;
}

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

=head2 $ptree-E<gt>B<top()>

        my $top_node = $ptree->top();
        $ptree->top( $top_node );
        $ptree->top( @children );

This method gets/sets the top node of the parse-tree. If no arguments are
given, it returns the topmost node in the tree (the root), which is also
a B<Pod::ParseTree>. If it is given a single argument that is a reference,
then the reference is assumed to a parse-tree and becomes the new top node.
Otherwise, if arguments are given, they are treated as the new list of
children for the top node.

=cut

sub top {
   my $self = shift;
   if (@_ > 0) {
      @{ $self } = (@_ == 1  and  ref $_[0]) ? ${ @_ } : @_;
   }
   return $self;
}

## let parse_tree() & ptree() be aliases for the 'top' method
*parse_tree = *ptree = \&top;

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

=head2 $ptree-E<gt>B<children()>

This method gets/sets the children of the top node in the parse-tree.
If no arguments are given, it returns the list (array) of children
(each of which should be either a string or a B<Pod::InteriorSequence>.
Otherwise, if arguments are given, they are treated as the new list of
children for the top node.

=cut

sub children {
   my $self = shift;
   if (@_ > 0) {
      @{ $self } = (@_ == 1  and  ref $_[0]) ? ${ @_ } : @_;
   }
   return @{ $self };
}

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

=head2 $ptree-E<gt>B<prepend()>

This method prepends the given text or parse-tree to the current parse-tree.
If the first item on the parse-tree is text and the argument is also text,
then the text is prepended to the first item (not added as a separate string).
Otherwise the argument is added as a new string or parse-tree I<before>
the current one.

=cut

use vars qw(@ptree);  ## an alias used for performance reasons

sub prepend {
   my $self = shift;
   local *ptree = $self;
   for (@_) {
      next  unless length;
      if (@ptree  and  !(ref $ptree[0])  and  !(ref $_)) {
         $ptree[0] = $_ . $ptree[0];
      }
      else {
         unshift @ptree, $_;
      }
   }
}

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

=head2 $ptree-E<gt>B<append()>

This method appends the given text or parse-tree to the current parse-tree.
If the last item on the parse-tree is text and the argument is also text,
then the text is appended to the last item (not added as a separate string).
Otherwise the argument is added as a new string or parse-tree I<after>
the current one.

=cut

sub append {
   my $self = shift;
   local *ptree = $self;
   for (@_) {
      next  unless length;
      if (@ptree  and  !(ref $ptree[-1])  and  !(ref $_)) {
         $ptree[-1] .= $_;
      }
      else {
         push @ptree, $_;
      }
   }
}

=head2 $ptree-E<gt>B<raw_text()>

        my $ptree_raw_text = $ptree->raw_text();

This method will return the I<raw> text of the POD parse-tree
exactly as it appeared in the input.

=cut

sub raw_text {
   my $self = shift;
   my $text = "";
   for ( @$self ) {
      $text .= (ref $_) ? $_->raw_text : $_;
   }
   return $text;
}

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

## Private routines to set/unset child->parent links

sub _unset_child2parent_links {
   my $self = shift;
   local *ptree = $self;
   for (@ptree) {
       next  unless (length  and  ref  and  ref ne 'SCALAR');
       $_->_unset_child2parent_links()
           if UNIVERSAL::isa($_, 'Pod::InteriorSequence');
   }
}

sub _set_child2parent_links {
    ## nothing to do, Pod::ParseTrees cant have parent pointers
}

=head2 Pod::ParseTree::B<DESTROY()>

This method performs any necessary cleanup for the parse-tree.
If you override this method then it is B<imperative>
that you invoke the parent method from within your own method,
otherwise I<parse-tree storage will not be reclaimed upon destruction!>

=cut

sub DESTROY {
   ## We need to get rid of all child->parent pointers throughout the
   ## tree so their reference counts will go to zero and they can be
   ## garbage-collected
   _unset_child2parent_links(@_);
}

#############################################################################

=head1 SEE ALSO

See L<Pod::Parser>, L<Pod::Select>

=head1 AUTHOR

Brad Appleton E<lt>[e-mail]<gt>

=cut

1;