InputObjects.pm
上传用户:shbosideng
上传日期:2013-05-04
资源大小:1555k
文件大小:27k
源码类别:

SNMP编程

开发平台:

C/C++

  1. #############################################################################
  2. # Pod/InputObjects.pm -- package which defines objects for input streams
  3. # and paragraphs and commands when parsing POD docs.
  4. #
  5. # Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved.
  6. # This file is part of "PodParser". PodParser is free software;
  7. # you can redistribute it and/or modify it under the same terms
  8. # as Perl itself.
  9. #############################################################################
  10. package Pod::InputObjects;
  11. use vars qw($VERSION);
  12. $VERSION = 1.13;  ## Current version of this package
  13. require  5.005;    ## requires this Perl version or later
  14. #############################################################################
  15. =head1 NAME
  16. Pod::InputObjects - objects representing POD input paragraphs, commands, etc.
  17. =head1 SYNOPSIS
  18.     use Pod::InputObjects;
  19. =head1 REQUIRES
  20. perl5.004, Carp
  21. =head1 EXPORTS
  22. Nothing.
  23. =head1 DESCRIPTION
  24. This module defines some basic input objects used by B<Pod::Parser> when
  25. reading and parsing POD text from an input source. The following objects
  26. are defined:
  27. =over 4
  28. =begin __PRIVATE__
  29. =item package B<Pod::InputSource>
  30. An object corresponding to a source of POD input text. It is mostly a
  31. wrapper around a filehandle or C<IO::Handle>-type object (or anything
  32. that implements the C<getline()> method) which keeps track of some
  33. additional information relevant to the parsing of PODs.
  34. =end __PRIVATE__
  35. =item package B<Pod::Paragraph>
  36. An object corresponding to a paragraph of POD input text. It may be a
  37. plain paragraph, a verbatim paragraph, or a command paragraph (see
  38. L<perlpod>).
  39. =item package B<Pod::InteriorSequence>
  40. An object corresponding to an interior sequence command from the POD
  41. input text (see L<perlpod>).
  42. =item package B<Pod::ParseTree>
  43. An object corresponding to a tree of parsed POD text. Each "node" in
  44. a parse-tree (or I<ptree>) is either a text-string or a reference to
  45. a B<Pod::InteriorSequence> object. The nodes appear in the parse-tree
  46. in the order in which they were parsed from left-to-right.
  47. =back
  48. Each of these input objects are described in further detail in the
  49. sections which follow.
  50. =cut
  51. #############################################################################
  52. use strict;
  53. #use diagnostics;
  54. #use Carp;
  55. #############################################################################
  56. package Pod::InputSource;
  57. ##---------------------------------------------------------------------------
  58. =begin __PRIVATE__
  59. =head1 B<Pod::InputSource>
  60. This object corresponds to an input source or stream of POD
  61. documentation. When parsing PODs, it is necessary to associate and store
  62. certain context information with each input source. All of this
  63. information is kept together with the stream itself in one of these
  64. C<Pod::InputSource> objects. Each such object is merely a wrapper around
  65. an C<IO::Handle> object of some kind (or at least something that
  66. implements the C<getline()> method). They have the following
  67. methods/attributes:
  68. =end __PRIVATE__
  69. =cut
  70. ##---------------------------------------------------------------------------
  71. =begin __PRIVATE__
  72. =head2 B<new()>
  73.         my $pod_input1 = Pod::InputSource->new(-handle => $filehandle);
  74.         my $pod_input2 = new Pod::InputSource(-handle => $filehandle,
  75.                                               -name   => $name);
  76.         my $pod_input3 = new Pod::InputSource(-handle => *STDIN);
  77.         my $pod_input4 = Pod::InputSource->new(-handle => *STDIN,
  78.                                                -name => "(STDIN)");
  79. This is a class method that constructs a C<Pod::InputSource> object and
  80. returns a reference to the new input source object. It takes one or more
  81. keyword arguments in the form of a hash. The keyword C<-handle> is
  82. required and designates the corresponding input handle. The keyword
  83. C<-name> is optional and specifies the name associated with the input
  84. handle (typically a file name).
  85. =end __PRIVATE__
  86. =cut
  87. sub new {
  88.     ## Determine if we were called via an object-ref or a classname
  89.     my $this = shift;
  90.     my $class = ref($this) || $this;
  91.     ## Any remaining arguments are treated as initial values for the
  92.     ## hash that is used to represent this object. Note that we default
  93.     ## certain values by specifying them *before* the arguments passed.
  94.     ## If they are in the argument list, they will override the defaults.
  95.     my $self = { -name        => '(unknown)',
  96.                  -handle      => undef,
  97.                  -was_cutting => 0,
  98.                  @_ };
  99.     ## Bless ourselves into the desired class and perform any initialization
  100.     bless $self, $class;
  101.     return $self;
  102. }
  103. ##---------------------------------------------------------------------------
  104. =begin __PRIVATE__
  105. =head2 B<name()>
  106.         my $filename = $pod_input->name();
  107.         $pod_input->name($new_filename_to_use);
  108. This method gets/sets the name of the input source (usually a filename).
  109. If no argument is given, it returns a string containing the name of
  110. the input source; otherwise it sets the name of the input source to the
  111. contents of the given argument.
  112. =end __PRIVATE__
  113. =cut
  114. sub name {
  115.    (@_ > 1)  and  $_[0]->{'-name'} = $_[1];
  116.    return $_[0]->{'-name'};
  117. }
  118. ## allow 'filename' as an alias for 'name'
  119. *filename = &name;
  120. ##---------------------------------------------------------------------------
  121. =begin __PRIVATE__
  122. =head2 B<handle()>
  123.         my $handle = $pod_input->handle();
  124. Returns a reference to the handle object from which input is read (the
  125. one used to contructed this input source object).
  126. =end __PRIVATE__
  127. =cut
  128. sub handle {
  129.    return $_[0]->{'-handle'};
  130. }
  131. ##---------------------------------------------------------------------------
  132. =begin __PRIVATE__
  133. =head2 B<was_cutting()>
  134.         print "Yes.n" if ($pod_input->was_cutting());
  135. The value of the C<cutting> state (that the B<cutting()> method would
  136. have returned) immediately before any input was read from this input
  137. stream. After all input from this stream has been read, the C<cutting>
  138. state is restored to this value.
  139. =end __PRIVATE__
  140. =cut
  141. sub was_cutting {
  142.    (@_ > 1)  and  $_[0]->{-was_cutting} = $_[1];
  143.    return $_[0]->{-was_cutting};
  144. }
  145. ##---------------------------------------------------------------------------
  146. #############################################################################
  147. package Pod::Paragraph;
  148. ##---------------------------------------------------------------------------
  149. =head1 B<Pod::Paragraph>
  150. An object representing a paragraph of POD input text.
  151. It has the following methods/attributes:
  152. =cut
  153. ##---------------------------------------------------------------------------
  154. =head2 Pod::Paragraph-E<gt>B<new()>
  155.         my $pod_para1 = Pod::Paragraph->new(-text => $text);
  156.         my $pod_para2 = Pod::Paragraph->new(-name => $cmd,
  157.                                             -text => $text);
  158.         my $pod_para3 = new Pod::Paragraph(-text => $text);
  159.         my $pod_para4 = new Pod::Paragraph(-name => $cmd,
  160.                                            -text => $text);
  161.         my $pod_para5 = Pod::Paragraph->new(-name => $cmd,
  162.                                             -text => $text,
  163.                                             -file => $filename,
  164.                                             -line => $line_number);
  165. This is a class method that constructs a C<Pod::Paragraph> object and
  166. returns a reference to the new paragraph object. It may be given one or
  167. two keyword arguments. The C<-text> keyword indicates the corresponding
  168. text of the POD paragraph. The C<-name> keyword indicates the name of
  169. the corresponding POD command, such as C<head1> or C<item> (it should
  170. I<not> contain the C<=> prefix); this is needed only if the POD
  171. paragraph corresponds to a command paragraph. The C<-file> and C<-line>
  172. keywords indicate the filename and line number corresponding to the
  173. beginning of the paragraph 
  174. =cut
  175. sub new {
  176.     ## Determine if we were called via an object-ref or a classname
  177.     my $this = shift;
  178.     my $class = ref($this) || $this;
  179.     ## Any remaining arguments are treated as initial values for the
  180.     ## hash that is used to represent this object. Note that we default
  181.     ## certain values by specifying them *before* the arguments passed.
  182.     ## If they are in the argument list, they will override the defaults.
  183.     my $self = {
  184.           -name       => undef,
  185.           -text       => (@_ == 1) ? $_[0] : undef,
  186.           -file       => '<unknown-file>',
  187.           -line       => 0,
  188.           -prefix     => '=',
  189.           -separator  => ' ',
  190.           -ptree => [],
  191.           @_
  192.     };
  193.     ## Bless ourselves into the desired class and perform any initialization
  194.     bless $self, $class;
  195.     return $self;
  196. }
  197. ##---------------------------------------------------------------------------
  198. =head2 $pod_para-E<gt>B<cmd_name()>
  199.         my $para_cmd = $pod_para->cmd_name();
  200. If this paragraph is a command paragraph, then this method will return 
  201. the name of the command (I<without> any leading C<=> prefix).
  202. =cut
  203. sub cmd_name {
  204.    (@_ > 1)  and  $_[0]->{'-name'} = $_[1];
  205.    return $_[0]->{'-name'};
  206. }
  207. ## let name() be an alias for cmd_name()
  208. *name = &cmd_name;
  209. ##---------------------------------------------------------------------------
  210. =head2 $pod_para-E<gt>B<text()>
  211.         my $para_text = $pod_para->text();
  212. This method will return the corresponding text of the paragraph.
  213. =cut
  214. sub text {
  215.    (@_ > 1)  and  $_[0]->{'-text'} = $_[1];
  216.    return $_[0]->{'-text'};
  217. }       
  218. ##---------------------------------------------------------------------------
  219. =head2 $pod_para-E<gt>B<raw_text()>
  220.         my $raw_pod_para = $pod_para->raw_text();
  221. This method will return the I<raw> text of the POD paragraph, exactly
  222. as it appeared in the input.
  223. =cut
  224. sub raw_text {
  225.    return $_[0]->{'-text'}  unless (defined $_[0]->{'-name'});
  226.    return $_[0]->{'-prefix'} . $_[0]->{'-name'} . 
  227.           $_[0]->{'-separator'} . $_[0]->{'-text'};
  228. }
  229. ##---------------------------------------------------------------------------
  230. =head2 $pod_para-E<gt>B<cmd_prefix()>
  231.         my $prefix = $pod_para->cmd_prefix();
  232. If this paragraph is a command paragraph, then this method will return 
  233. the prefix used to denote the command (which should be the string "="
  234. or "==").
  235. =cut
  236. sub cmd_prefix {
  237.    return $_[0]->{'-prefix'};
  238. }
  239. ##---------------------------------------------------------------------------
  240. =head2 $pod_para-E<gt>B<cmd_separator()>
  241.         my $separator = $pod_para->cmd_separator();
  242. If this paragraph is a command paragraph, then this method will return
  243. the text used to separate the command name from the rest of the
  244. paragraph (if any).
  245. =cut
  246. sub cmd_separator {
  247.    return $_[0]->{'-separator'};
  248. }
  249. ##---------------------------------------------------------------------------
  250. =head2 $pod_para-E<gt>B<parse_tree()>
  251.         my $ptree = $pod_parser->parse_text( $pod_para->text() );
  252.         $pod_para->parse_tree( $ptree );
  253.         $ptree = $pod_para->parse_tree();
  254. This method will get/set the corresponding parse-tree of the paragraph's text.
  255. =cut
  256. sub parse_tree {
  257.    (@_ > 1)  and  $_[0]->{'-ptree'} = $_[1];
  258.    return $_[0]->{'-ptree'};
  259. }       
  260. ## let ptree() be an alias for parse_tree()
  261. *ptree = &parse_tree;
  262. ##---------------------------------------------------------------------------
  263. =head2 $pod_para-E<gt>B<file_line()>
  264.         my ($filename, $line_number) = $pod_para->file_line();
  265.         my $position = $pod_para->file_line();
  266. Returns the current filename and line number for the paragraph
  267. object.  If called in an array context, it returns a list of two
  268. elements: first the filename, then the line number. If called in
  269. a scalar context, it returns a string containing the filename, followed
  270. by a colon (':'), followed by the line number.
  271. =cut
  272. sub file_line {
  273.    my @loc = ($_[0]->{'-file'} || '<unknown-file>',
  274.               $_[0]->{'-line'} || 0);
  275.    return (wantarray) ? @loc : join(':', @loc);
  276. }
  277. ##---------------------------------------------------------------------------
  278. #############################################################################
  279. package Pod::InteriorSequence;
  280. ##---------------------------------------------------------------------------
  281. =head1 B<Pod::InteriorSequence>
  282. An object representing a POD interior sequence command.
  283. It has the following methods/attributes:
  284. =cut
  285. ##---------------------------------------------------------------------------
  286. =head2 Pod::InteriorSequence-E<gt>B<new()>
  287.         my $pod_seq1 = Pod::InteriorSequence->new(-name => $cmd
  288.                                                   -ldelim => $delimiter);
  289.         my $pod_seq2 = new Pod::InteriorSequence(-name => $cmd,
  290.                                                  -ldelim => $delimiter);
  291.         my $pod_seq3 = new Pod::InteriorSequence(-name => $cmd,
  292.                                                  -ldelim => $delimiter,
  293.                                                  -file => $filename,
  294.                                                  -line => $line_number);
  295.         my $pod_seq4 = new Pod::InteriorSequence(-name => $cmd, $ptree);
  296.         my $pod_seq5 = new Pod::InteriorSequence($cmd, $ptree);
  297. This is a class method that constructs a C<Pod::InteriorSequence> object
  298. and returns a reference to the new interior sequence object. It should
  299. be given two keyword arguments.  The C<-ldelim> keyword indicates the
  300. corresponding left-delimiter of the interior sequence (e.g. 'E<lt>').
  301. The C<-name> keyword indicates the name of the corresponding interior
  302. sequence command, such as C<I> or C<B> or C<C>. The C<-file> and
  303. C<-line> keywords indicate the filename and line number corresponding
  304. to the beginning of the interior sequence. If the C<$ptree> argument is
  305. given, it must be the last argument, and it must be either string, or
  306. else an array-ref suitable for passing to B<Pod::ParseTree::new> (or
  307. it may be a reference to an Pod::ParseTree object).
  308. =cut
  309. sub new {
  310.     ## Determine if we were called via an object-ref or a classname
  311.     my $this = shift;
  312.     my $class = ref($this) || $this;
  313.     ## See if first argument has no keyword
  314.     if (((@_ <= 2) or (@_ % 2)) and $_[0] !~ /^-w/) {
  315.        ## Yup - need an implicit '-name' before first parameter
  316.        unshift @_, '-name';
  317.     }
  318.     ## See if odd number of args
  319.     if ((@_ % 2) != 0) {
  320.        ## Yup - need an implicit '-ptree' before the last parameter
  321.        splice @_, $#_, 0, '-ptree';
  322.     }
  323.     ## Any remaining arguments are treated as initial values for the
  324.     ## hash that is used to represent this object. Note that we default
  325.     ## certain values by specifying them *before* the arguments passed.
  326.     ## If they are in the argument list, they will override the defaults.
  327.     my $self = {
  328.           -name       => (@_ == 1) ? $_[0] : undef,
  329.           -file       => '<unknown-file>',
  330.           -line       => 0,
  331.           -ldelim     => '<',
  332.           -rdelim     => '>',
  333.           @_
  334.     };
  335.     ## Initialize contents if they havent been already
  336.     my $ptree = $self->{'-ptree'} || new Pod::ParseTree();
  337.     if ( ref $ptree =~ /^(ARRAY)?$/ ) {
  338.         ## We have an array-ref, or a normal scalar. Pass it as an
  339.         ## an argument to the ptree-constructor
  340.         $ptree = new Pod::ParseTree($1 ? [$ptree] : $ptree);
  341.     }
  342.     $self->{'-ptree'} = $ptree;
  343.     ## Bless ourselves into the desired class and perform any initialization
  344.     bless $self, $class;
  345.     return $self;
  346. }
  347. ##---------------------------------------------------------------------------
  348. =head2 $pod_seq-E<gt>B<cmd_name()>
  349.         my $seq_cmd = $pod_seq->cmd_name();
  350. The name of the interior sequence command.
  351. =cut
  352. sub cmd_name {
  353.    (@_ > 1)  and  $_[0]->{'-name'} = $_[1];
  354.    return $_[0]->{'-name'};
  355. }
  356. ## let name() be an alias for cmd_name()
  357. *name = &cmd_name;
  358. ##---------------------------------------------------------------------------
  359. ## Private subroutine to set the parent pointer of all the given
  360. ## children that are interior-sequences to be $self
  361. sub _set_child2parent_links {
  362.    my ($self, @children) = @_;
  363.    ## Make sure any sequences know who their parent is
  364.    for (@children) {
  365.       next  unless (length  and  ref  and  ref ne 'SCALAR');
  366.       if (UNIVERSAL::isa($_, 'Pod::InteriorSequence') or
  367.           UNIVERSAL::can($_, 'nested'))
  368.       {
  369.           $_->nested($self);
  370.       }
  371.    }
  372. }
  373. ## Private subroutine to unset child->parent links
  374. sub _unset_child2parent_links {
  375.    my $self = shift;
  376.    $self->{'-parent_sequence'} = undef;
  377.    my $ptree = $self->{'-ptree'};
  378.    for (@$ptree) {
  379.       next  unless (length  and  ref  and  ref ne 'SCALAR');
  380.       $_->_unset_child2parent_links()
  381.           if UNIVERSAL::isa($_, 'Pod::InteriorSequence');
  382.    }
  383. }
  384. ##---------------------------------------------------------------------------
  385. =head2 $pod_seq-E<gt>B<prepend()>
  386.         $pod_seq->prepend($text);
  387.         $pod_seq1->prepend($pod_seq2);
  388. Prepends the given string or parse-tree or sequence object to the parse-tree
  389. of this interior sequence.
  390. =cut
  391. sub prepend {
  392.    my $self  = shift;
  393.    $self->{'-ptree'}->prepend(@_);
  394.    _set_child2parent_links($self, @_);
  395.    return $self;
  396. }       
  397. ##---------------------------------------------------------------------------
  398. =head2 $pod_seq-E<gt>B<append()>
  399.         $pod_seq->append($text);
  400.         $pod_seq1->append($pod_seq2);
  401. Appends the given string or parse-tree or sequence object to the parse-tree
  402. of this interior sequence.
  403. =cut
  404. sub append {
  405.    my $self = shift;
  406.    $self->{'-ptree'}->append(@_);
  407.    _set_child2parent_links($self, @_);
  408.    return $self;
  409. }       
  410. ##---------------------------------------------------------------------------
  411. =head2 $pod_seq-E<gt>B<nested()>
  412.         $outer_seq = $pod_seq->nested || print "not nested";
  413. If this interior sequence is nested inside of another interior
  414. sequence, then the outer/parent sequence that contains it is
  415. returned. Otherwise C<undef> is returned.
  416. =cut
  417. sub nested {
  418.    my $self = shift;
  419.   (@_ == 1)  and  $self->{'-parent_sequence'} = shift;
  420.    return  $self->{'-parent_sequence'} || undef;
  421. }
  422. ##---------------------------------------------------------------------------
  423. =head2 $pod_seq-E<gt>B<raw_text()>
  424.         my $seq_raw_text = $pod_seq->raw_text();
  425. This method will return the I<raw> text of the POD interior sequence,
  426. exactly as it appeared in the input.
  427. =cut
  428. sub raw_text {
  429.    my $self = shift;
  430.    my $text = $self->{'-name'} . $self->{'-ldelim'};
  431.    for ( $self->{'-ptree'}->children ) {
  432.       $text .= (ref $_) ? $_->raw_text : $_;
  433.    }
  434.    $text .= $self->{'-rdelim'};
  435.    return $text;
  436. }
  437. ##---------------------------------------------------------------------------
  438. =head2 $pod_seq-E<gt>B<left_delimiter()>
  439.         my $ldelim = $pod_seq->left_delimiter();
  440. The leftmost delimiter beginning the argument text to the interior
  441. sequence (should be "<").
  442. =cut
  443. sub left_delimiter {
  444.    (@_ > 1)  and  $_[0]->{'-ldelim'} = $_[1];
  445.    return $_[0]->{'-ldelim'};
  446. }
  447. ## let ldelim() be an alias for left_delimiter()
  448. *ldelim = &left_delimiter;
  449. ##---------------------------------------------------------------------------
  450. =head2 $pod_seq-E<gt>B<right_delimiter()>
  451. The rightmost delimiter beginning the argument text to the interior
  452. sequence (should be ">").
  453. =cut
  454. sub right_delimiter {
  455.    (@_ > 1)  and  $_[0]->{'-rdelim'} = $_[1];
  456.    return $_[0]->{'-rdelim'};
  457. }
  458. ## let rdelim() be an alias for right_delimiter()
  459. *rdelim = &right_delimiter;
  460. ##---------------------------------------------------------------------------
  461. =head2 $pod_seq-E<gt>B<parse_tree()>
  462.         my $ptree = $pod_parser->parse_text($paragraph_text);
  463.         $pod_seq->parse_tree( $ptree );
  464.         $ptree = $pod_seq->parse_tree();
  465. This method will get/set the corresponding parse-tree of the interior
  466. sequence's text.
  467. =cut
  468. sub parse_tree {
  469.    (@_ > 1)  and  $_[0]->{'-ptree'} = $_[1];
  470.    return $_[0]->{'-ptree'};
  471. }       
  472. ## let ptree() be an alias for parse_tree()
  473. *ptree = &parse_tree;
  474. ##---------------------------------------------------------------------------
  475. =head2 $pod_seq-E<gt>B<file_line()>
  476.         my ($filename, $line_number) = $pod_seq->file_line();
  477.         my $position = $pod_seq->file_line();
  478. Returns the current filename and line number for the interior sequence
  479. object.  If called in an array context, it returns a list of two
  480. elements: first the filename, then the line number. If called in
  481. a scalar context, it returns a string containing the filename, followed
  482. by a colon (':'), followed by the line number.
  483. =cut
  484. sub file_line {
  485.    my @loc = ($_[0]->{'-file'}  || '<unknown-file>',
  486.               $_[0]->{'-line'}  || 0);
  487.    return (wantarray) ? @loc : join(':', @loc);
  488. }
  489. ##---------------------------------------------------------------------------
  490. =head2 Pod::InteriorSequence::B<DESTROY()>
  491. This method performs any necessary cleanup for the interior-sequence.
  492. If you override this method then it is B<imperative> that you invoke
  493. the parent method from within your own method, otherwise
  494. I<interior-sequence storage will not be reclaimed upon destruction!>
  495. =cut
  496. sub DESTROY {
  497.    ## We need to get rid of all child->parent pointers throughout the
  498.    ## tree so their reference counts will go to zero and they can be
  499.    ## garbage-collected
  500.    _unset_child2parent_links(@_);
  501. }
  502. ##---------------------------------------------------------------------------
  503. #############################################################################
  504. package Pod::ParseTree;
  505. ##---------------------------------------------------------------------------
  506. =head1 B<Pod::ParseTree>
  507. This object corresponds to a tree of parsed POD text. As POD text is
  508. scanned from left to right, it is parsed into an ordered list of
  509. text-strings and B<Pod::InteriorSequence> objects (in order of
  510. appearance). A B<Pod::ParseTree> object corresponds to this list of
  511. strings and sequences. Each interior sequence in the parse-tree may
  512. itself contain a parse-tree (since interior sequences may be nested).
  513. =cut
  514. ##---------------------------------------------------------------------------
  515. =head2 Pod::ParseTree-E<gt>B<new()>
  516.         my $ptree1 = Pod::ParseTree->new;
  517.         my $ptree2 = new Pod::ParseTree;
  518.         my $ptree4 = Pod::ParseTree->new($array_ref);
  519.         my $ptree3 = new Pod::ParseTree($array_ref);
  520. This is a class method that constructs a C<Pod::Parse_tree> object and
  521. returns a reference to the new parse-tree. If a single-argument is given,
  522. it must be a reference to an array, and is used to initialize the root
  523. (top) of the parse tree.
  524. =cut
  525. sub new {
  526.     ## Determine if we were called via an object-ref or a classname
  527.     my $this = shift;
  528.     my $class = ref($this) || $this;
  529.     my $self = (@_ == 1  and  ref $_[0]) ? $_[0] : [];
  530.     ## Bless ourselves into the desired class and perform any initialization
  531.     bless $self, $class;
  532.     return $self;
  533. }
  534. ##---------------------------------------------------------------------------
  535. =head2 $ptree-E<gt>B<top()>
  536.         my $top_node = $ptree->top();
  537.         $ptree->top( $top_node );
  538.         $ptree->top( @children );
  539. This method gets/sets the top node of the parse-tree. If no arguments are
  540. given, it returns the topmost node in the tree (the root), which is also
  541. a B<Pod::ParseTree>. If it is given a single argument that is a reference,
  542. then the reference is assumed to a parse-tree and becomes the new top node.
  543. Otherwise, if arguments are given, they are treated as the new list of
  544. children for the top node.
  545. =cut
  546. sub top {
  547.    my $self = shift;
  548.    if (@_ > 0) {
  549.       @{ $self } = (@_ == 1  and  ref $_[0]) ? ${ @_ } : @_;
  550.    }
  551.    return $self;
  552. }
  553. ## let parse_tree() & ptree() be aliases for the 'top' method
  554. *parse_tree = *ptree = &top;
  555. ##---------------------------------------------------------------------------
  556. =head2 $ptree-E<gt>B<children()>
  557. This method gets/sets the children of the top node in the parse-tree.
  558. If no arguments are given, it returns the list (array) of children
  559. (each of which should be either a string or a B<Pod::InteriorSequence>.
  560. Otherwise, if arguments are given, they are treated as the new list of
  561. children for the top node.
  562. =cut
  563. sub children {
  564.    my $self = shift;
  565.    if (@_ > 0) {
  566.       @{ $self } = (@_ == 1  and  ref $_[0]) ? ${ @_ } : @_;
  567.    }
  568.    return @{ $self };
  569. }
  570. ##---------------------------------------------------------------------------
  571. =head2 $ptree-E<gt>B<prepend()>
  572. This method prepends the given text or parse-tree to the current parse-tree.
  573. If the first item on the parse-tree is text and the argument is also text,
  574. then the text is prepended to the first item (not added as a separate string).
  575. Otherwise the argument is added as a new string or parse-tree I<before>
  576. the current one.
  577. =cut
  578. use vars qw(@ptree);  ## an alias used for performance reasons
  579. sub prepend {
  580.    my $self = shift;
  581.    local *ptree = $self;
  582.    for (@_) {
  583.       next  unless length;
  584.       if (@ptree  and  !(ref $ptree[0])  and  !(ref $_)) {
  585.          $ptree[0] = $_ . $ptree[0];
  586.       }
  587.       else {
  588.          unshift @ptree, $_;
  589.       }
  590.    }
  591. }
  592. ##---------------------------------------------------------------------------
  593. =head2 $ptree-E<gt>B<append()>
  594. This method appends the given text or parse-tree to the current parse-tree.
  595. If the last item on the parse-tree is text and the argument is also text,
  596. then the text is appended to the last item (not added as a separate string).
  597. Otherwise the argument is added as a new string or parse-tree I<after>
  598. the current one.
  599. =cut
  600. sub append {
  601.    my $self = shift;
  602.    local *ptree = $self;
  603.    for (@_) {
  604.       next  unless length;
  605.       if (@ptree  and  !(ref $ptree[-1])  and  !(ref $_)) {
  606.          $ptree[-1] .= $_;
  607.       }
  608.       else {
  609.          push @ptree, $_;
  610.       }
  611.    }
  612. }
  613. =head2 $ptree-E<gt>B<raw_text()>
  614.         my $ptree_raw_text = $ptree->raw_text();
  615. This method will return the I<raw> text of the POD parse-tree
  616. exactly as it appeared in the input.
  617. =cut
  618. sub raw_text {
  619.    my $self = shift;
  620.    my $text = "";
  621.    for ( @$self ) {
  622.       $text .= (ref $_) ? $_->raw_text : $_;
  623.    }
  624.    return $text;
  625. }
  626. ##---------------------------------------------------------------------------
  627. ## Private routines to set/unset child->parent links
  628. sub _unset_child2parent_links {
  629.    my $self = shift;
  630.    local *ptree = $self;
  631.    for (@ptree) {
  632.        next  unless (length  and  ref  and  ref ne 'SCALAR');
  633.        $_->_unset_child2parent_links()
  634.            if UNIVERSAL::isa($_, 'Pod::InteriorSequence');
  635.    }
  636. }
  637. sub _set_child2parent_links {
  638.     ## nothing to do, Pod::ParseTrees cant have parent pointers
  639. }
  640. =head2 Pod::ParseTree::B<DESTROY()>
  641. This method performs any necessary cleanup for the parse-tree.
  642. If you override this method then it is B<imperative>
  643. that you invoke the parent method from within your own method,
  644. otherwise I<parse-tree storage will not be reclaimed upon destruction!>
  645. =cut
  646. sub DESTROY {
  647.    ## We need to get rid of all child->parent pointers throughout the
  648.    ## tree so their reference counts will go to zero and they can be
  649.    ## garbage-collected
  650.    _unset_child2parent_links(@_);
  651. }
  652. #############################################################################
  653. =head1 SEE ALSO
  654. See L<Pod::Parser>, L<Pod::Select>
  655. =head1 AUTHOR
  656. Brad Appleton E<lt>bradapp@enteract.comE<gt>
  657. =cut
  658. 1;