[Summary view] [Print] [Text view]

   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  
  11  package Pod::InputObjects;
  12  
  13  use vars qw($VERSION);
  14  $VERSION = 1.30;  ## Current version of this package
  15  require  5.005;    ## requires this Perl version or later
  16  
  17  #############################################################################
  18  
  19  =head1 NAME
  20  
  21  Pod::InputObjects - objects representing POD input paragraphs, commands, etc.
  22  
  23  =head1 SYNOPSIS
  24  
  25      use Pod::InputObjects;
  26  
  27  =head1 REQUIRES
  28  
  29  perl5.004, Carp
  30  
  31  =head1 EXPORTS
  32  
  33  Nothing.
  34  
  35  =head1 DESCRIPTION
  36  
  37  This module defines some basic input objects used by B<Pod::Parser> when
  38  reading and parsing POD text from an input source. The following objects
  39  are defined:
  40  
  41  =over 4
  42  
  43  =begin __PRIVATE__
  44  
  45  =item package B<Pod::InputSource>
  46  
  47  An object corresponding to a source of POD input text. It is mostly a
  48  wrapper around a filehandle or C<IO::Handle>-type object (or anything
  49  that implements the C<getline()> method) which keeps track of some
  50  additional information relevant to the parsing of PODs.
  51  
  52  =end __PRIVATE__
  53  
  54  =item package B<Pod::Paragraph>
  55  
  56  An object corresponding to a paragraph of POD input text. It may be a
  57  plain paragraph, a verbatim paragraph, or a command paragraph (see
  58  L<perlpod>).
  59  
  60  =item package B<Pod::InteriorSequence>
  61  
  62  An object corresponding to an interior sequence command from the POD
  63  input text (see L<perlpod>).
  64  
  65  =item package B<Pod::ParseTree>
  66  
  67  An object corresponding to a tree of parsed POD text. Each "node" in
  68  a parse-tree (or I<ptree>) is either a text-string or a reference to
  69  a B<Pod::InteriorSequence> object. The nodes appear in the parse-tree
  70  in the order in which they were parsed from left-to-right.
  71  
  72  =back
  73  
  74  Each of these input objects are described in further detail in the
  75  sections which follow.
  76  
  77  =cut
  78  
  79  #############################################################################
  80  
  81  use strict;
  82  #use diagnostics;
  83  #use Carp;
  84  
  85  #############################################################################
  86  
  87  package Pod::InputSource;
  88  
  89  ##---------------------------------------------------------------------------
  90  
  91  =begin __PRIVATE__
  92  
  93  =head1 B<Pod::InputSource>
  94  
  95  This object corresponds to an input source or stream of POD
  96  documentation. When parsing PODs, it is necessary to associate and store
  97  certain context information with each input source. All of this
  98  information is kept together with the stream itself in one of these
  99  C<Pod::InputSource> objects. Each such object is merely a wrapper around
 100  an C<IO::Handle> object of some kind (or at least something that
 101  implements the C<getline()> method). They have the following
 102  methods/attributes:
 103  
 104  =end __PRIVATE__
 105  
 106  =cut
 107  
 108  ##---------------------------------------------------------------------------
 109  
 110  =begin __PRIVATE__
 111  
 112  =head2 B<new()>
 113  
 114          my $pod_input1 = Pod::InputSource->new(-handle => $filehandle);
 115          my $pod_input2 = new Pod::InputSource(-handle => $filehandle,
 116                                                -name   => $name);
 117          my $pod_input3 = new Pod::InputSource(-handle => \*STDIN);
 118          my $pod_input4 = Pod::InputSource->new(-handle => \*STDIN,
 119                                                 -name => "(STDIN)");
 120  
 121  This is a class method that constructs a C<Pod::InputSource> object and
 122  returns a reference to the new input source object. It takes one or more
 123  keyword arguments in the form of a hash. The keyword C<-handle> is
 124  required and designates the corresponding input handle. The keyword
 125  C<-name> is optional and specifies the name associated with the input
 126  handle (typically a file name).
 127  
 128  =end __PRIVATE__
 129  
 130  =cut
 131  
 132  sub new {
 133      ## Determine if we were called via an object-ref or a classname
 134      my $this = shift;
 135      my $class = ref($this) || $this;
 136  
 137      ## Any remaining arguments are treated as initial values for the
 138      ## hash that is used to represent this object. Note that we default
 139      ## certain values by specifying them *before* the arguments passed.
 140      ## If they are in the argument list, they will override the defaults.
 141      my $self = { -name        => '(unknown)',
 142                   -handle      => undef,
 143                   -was_cutting => 0,
 144                   @_ };
 145  
 146      ## Bless ourselves into the desired class and perform any initialization
 147      bless $self, $class;
 148      return $self;
 149  }
 150  
 151  ##---------------------------------------------------------------------------
 152  
 153  =begin __PRIVATE__
 154  
 155  =head2 B<name()>
 156  
 157          my $filename = $pod_input->name();
 158          $pod_input->name($new_filename_to_use);
 159  
 160  This method gets/sets the name of the input source (usually a filename).
 161  If no argument is given, it returns a string containing the name of
 162  the input source; otherwise it sets the name of the input source to the
 163  contents of the given argument.
 164  
 165  =end __PRIVATE__
 166  
 167  =cut
 168  
 169  sub name {
 170     (@_ > 1)  and  $_[0]->{'-name'} = $_[1];
 171     return $_[0]->{'-name'};
 172  }
 173  
 174  ## allow 'filename' as an alias for 'name'
 175  *filename = \&name;
 176  
 177  ##---------------------------------------------------------------------------
 178  
 179  =begin __PRIVATE__
 180  
 181  =head2 B<handle()>
 182  
 183          my $handle = $pod_input->handle();
 184  
 185  Returns a reference to the handle object from which input is read (the
 186  one used to contructed this input source object).
 187  
 188  =end __PRIVATE__
 189  
 190  =cut
 191  
 192  sub handle {
 193     return $_[0]->{'-handle'};
 194  }
 195  
 196  ##---------------------------------------------------------------------------
 197  
 198  =begin __PRIVATE__
 199  
 200  =head2 B<was_cutting()>
 201  
 202          print "Yes.\n" if ($pod_input->was_cutting());
 203  
 204  The value of the C<cutting> state (that the B<cutting()> method would
 205  have returned) immediately before any input was read from this input
 206  stream. After all input from this stream has been read, the C<cutting>
 207  state is restored to this value.
 208  
 209  =end __PRIVATE__
 210  
 211  =cut
 212  
 213  sub was_cutting {
 214     (@_ > 1)  and  $_[0]->{-was_cutting} = $_[1];
 215     return $_[0]->{-was_cutting};
 216  }
 217  
 218  ##---------------------------------------------------------------------------
 219  
 220  #############################################################################
 221  
 222  package Pod::Paragraph;
 223  
 224  ##---------------------------------------------------------------------------
 225  
 226  =head1 B<Pod::Paragraph>
 227  
 228  An object representing a paragraph of POD input text.
 229  It has the following methods/attributes:
 230  
 231  =cut
 232  
 233  ##---------------------------------------------------------------------------
 234  
 235  =head2 Pod::Paragraph-E<gt>B<new()>
 236  
 237          my $pod_para1 = Pod::Paragraph->new(-text => $text);
 238          my $pod_para2 = Pod::Paragraph->new(-name => $cmd,
 239                                              -text => $text);
 240          my $pod_para3 = new Pod::Paragraph(-text => $text);
 241          my $pod_para4 = new Pod::Paragraph(-name => $cmd,
 242                                             -text => $text);
 243          my $pod_para5 = Pod::Paragraph->new(-name => $cmd,
 244                                              -text => $text,
 245                                              -file => $filename,
 246                                              -line => $line_number);
 247  
 248  This is a class method that constructs a C<Pod::Paragraph> object and
 249  returns a reference to the new paragraph object. It may be given one or
 250  two keyword arguments. The C<-text> keyword indicates the corresponding
 251  text of the POD paragraph. The C<-name> keyword indicates the name of
 252  the corresponding POD command, such as C<head1> or C<item> (it should
 253  I<not> contain the C<=> prefix); this is needed only if the POD
 254  paragraph corresponds to a command paragraph. The C<-file> and C<-line>
 255  keywords indicate the filename and line number corresponding to the
 256  beginning of the paragraph 
 257  
 258  =cut
 259  
 260  sub new {
 261      ## Determine if we were called via an object-ref or a classname
 262      my $this = shift;
 263      my $class = ref($this) || $this;
 264  
 265      ## Any remaining arguments are treated as initial values for the
 266      ## hash that is used to represent this object. Note that we default
 267      ## certain values by specifying them *before* the arguments passed.
 268      ## If they are in the argument list, they will override the defaults.
 269      my $self = {
 270            -name       => undef,
 271            -text       => (@_ == 1) ? shift : undef,
 272            -file       => '<unknown-file>',
 273            -line       => 0,
 274            -prefix     => '=',
 275            -separator  => ' ',
 276            -ptree => [],
 277            @_
 278      };
 279  
 280      ## Bless ourselves into the desired class and perform any initialization
 281      bless $self, $class;
 282      return $self;
 283  }
 284  
 285  ##---------------------------------------------------------------------------
 286  
 287  =head2 $pod_para-E<gt>B<cmd_name()>
 288  
 289          my $para_cmd = $pod_para->cmd_name();
 290  
 291  If this paragraph is a command paragraph, then this method will return 
 292  the name of the command (I<without> any leading C<=> prefix).
 293  
 294  =cut
 295  
 296  sub cmd_name {
 297     (@_ > 1)  and  $_[0]->{'-name'} = $_[1];
 298     return $_[0]->{'-name'};
 299  }
 300  
 301  ## let name() be an alias for cmd_name()
 302  *name = \&cmd_name;
 303  
 304  ##---------------------------------------------------------------------------
 305  
 306  =head2 $pod_para-E<gt>B<text()>
 307  
 308          my $para_text = $pod_para->text();
 309  
 310  This method will return the corresponding text of the paragraph.
 311  
 312  =cut
 313  
 314  sub text {
 315     (@_ > 1)  and  $_[0]->{'-text'} = $_[1];
 316     return $_[0]->{'-text'};
 317  }       
 318  
 319  ##---------------------------------------------------------------------------
 320  
 321  =head2 $pod_para-E<gt>B<raw_text()>
 322  
 323          my $raw_pod_para = $pod_para->raw_text();
 324  
 325  This method will return the I<raw> text of the POD paragraph, exactly
 326  as it appeared in the input.
 327  
 328  =cut
 329  
 330  sub raw_text {
 331     return $_[0]->{'-text'}  unless (defined $_[0]->{'-name'});
 332     return $_[0]->{'-prefix'} . $_[0]->{'-name'} . 
 333            $_[0]->{'-separator'} . $_[0]->{'-text'};
 334  }
 335  
 336  ##---------------------------------------------------------------------------
 337  
 338  =head2 $pod_para-E<gt>B<cmd_prefix()>
 339  
 340          my $prefix = $pod_para->cmd_prefix();
 341  
 342  If this paragraph is a command paragraph, then this method will return 
 343  the prefix used to denote the command (which should be the string "="
 344  or "==").
 345  
 346  =cut
 347  
 348  sub cmd_prefix {
 349     return $_[0]->{'-prefix'};
 350  }
 351  
 352  ##---------------------------------------------------------------------------
 353  
 354  =head2 $pod_para-E<gt>B<cmd_separator()>
 355  
 356          my $separator = $pod_para->cmd_separator();
 357  
 358  If this paragraph is a command paragraph, then this method will return
 359  the text used to separate the command name from the rest of the
 360  paragraph (if any).
 361  
 362  =cut
 363  
 364  sub cmd_separator {
 365     return $_[0]->{'-separator'};
 366  }
 367  
 368  ##---------------------------------------------------------------------------
 369  
 370  =head2 $pod_para-E<gt>B<parse_tree()>
 371  
 372          my $ptree = $pod_parser->parse_text( $pod_para->text() );
 373          $pod_para->parse_tree( $ptree );
 374          $ptree = $pod_para->parse_tree();
 375  
 376  This method will get/set the corresponding parse-tree of the paragraph's text.
 377  
 378  =cut
 379  
 380  sub parse_tree {
 381     (@_ > 1)  and  $_[0]->{'-ptree'} = $_[1];
 382     return $_[0]->{'-ptree'};
 383  }       
 384  
 385  ## let ptree() be an alias for parse_tree()
 386  *ptree = \&parse_tree;
 387  
 388  ##---------------------------------------------------------------------------
 389  
 390  =head2 $pod_para-E<gt>B<file_line()>
 391  
 392          my ($filename, $line_number) = $pod_para->file_line();
 393          my $position = $pod_para->file_line();
 394  
 395  Returns the current filename and line number for the paragraph
 396  object.  If called in a list context, it returns a list of two
 397  elements: first the filename, then the line number. If called in
 398  a scalar context, it returns a string containing the filename, followed
 399  by a colon (':'), followed by the line number.
 400  
 401  =cut
 402  
 403  sub file_line {
 404     my @loc = ($_[0]->{'-file'} || '<unknown-file>',
 405                $_[0]->{'-line'} || 0);
 406     return (wantarray) ? @loc : join(':', @loc);
 407  }
 408  
 409  ##---------------------------------------------------------------------------
 410  
 411  #############################################################################
 412  
 413  package Pod::InteriorSequence;
 414  
 415  ##---------------------------------------------------------------------------
 416  
 417  =head1 B<Pod::InteriorSequence>
 418  
 419  An object representing a POD interior sequence command.
 420  It has the following methods/attributes:
 421  
 422  =cut
 423  
 424  ##---------------------------------------------------------------------------
 425  
 426  =head2 Pod::InteriorSequence-E<gt>B<new()>
 427  
 428          my $pod_seq1 = Pod::InteriorSequence->new(-name => $cmd
 429                                                    -ldelim => $delimiter);
 430          my $pod_seq2 = new Pod::InteriorSequence(-name => $cmd,
 431                                                   -ldelim => $delimiter);
 432          my $pod_seq3 = new Pod::InteriorSequence(-name => $cmd,
 433                                                   -ldelim => $delimiter,
 434                                                   -file => $filename,
 435                                                   -line => $line_number);
 436  
 437          my $pod_seq4 = new Pod::InteriorSequence(-name => $cmd, $ptree);
 438          my $pod_seq5 = new Pod::InteriorSequence($cmd, $ptree);
 439  
 440  This is a class method that constructs a C<Pod::InteriorSequence> object
 441  and returns a reference to the new interior sequence object. It should
 442  be given two keyword arguments.  The C<-ldelim> keyword indicates the
 443  corresponding left-delimiter of the interior sequence (e.g. 'E<lt>').
 444  The C<-name> keyword indicates the name of the corresponding interior
 445  sequence command, such as C<I> or C<B> or C<C>. The C<-file> and
 446  C<-line> keywords indicate the filename and line number corresponding
 447  to the beginning of the interior sequence. If the C<$ptree> argument is
 448  given, it must be the last argument, and it must be either string, or
 449  else an array-ref suitable for passing to B<Pod::ParseTree::new> (or
 450  it may be a reference to a Pod::ParseTree object).
 451  
 452  =cut
 453  
 454  sub new {
 455      ## Determine if we were called via an object-ref or a classname
 456      my $this = shift;
 457      my $class = ref($this) || $this;
 458  
 459      ## See if first argument has no keyword
 460      if (((@_ <= 2) or (@_ % 2)) and $_[0] !~ /^-\w/) {
 461         ## Yup - need an implicit '-name' before first parameter
 462         unshift @_, '-name';
 463      }
 464  
 465      ## See if odd number of args
 466      if ((@_ % 2) != 0) {
 467         ## Yup - need an implicit '-ptree' before the last parameter
 468         splice @_, $#_, 0, '-ptree';
 469      }
 470  
 471      ## Any remaining arguments are treated as initial values for the
 472      ## hash that is used to represent this object. Note that we default
 473      ## certain values by specifying them *before* the arguments passed.
 474      ## If they are in the argument list, they will override the defaults.
 475      my $self = {
 476            -name       => (@_ == 1) ? $_[0] : undef,
 477            -file       => '<unknown-file>',
 478            -line       => 0,
 479            -ldelim     => '<',
 480            -rdelim     => '>',
 481            @_
 482      };
 483  
 484      ## Initialize contents if they havent been already
 485      my $ptree = $self->{'-ptree'} || new Pod::ParseTree();
 486      if ( ref $ptree =~ /^(ARRAY)?$/ ) {
 487          ## We have an array-ref, or a normal scalar. Pass it as an
 488          ## an argument to the ptree-constructor
 489          $ptree = new Pod::ParseTree($1 ? [$ptree] : $ptree);
 490      }
 491      $self->{'-ptree'} = $ptree;
 492  
 493      ## Bless ourselves into the desired class and perform any initialization
 494      bless $self, $class;
 495      return $self;
 496  }
 497  
 498  ##---------------------------------------------------------------------------
 499  
 500  =head2 $pod_seq-E<gt>B<cmd_name()>
 501  
 502          my $seq_cmd = $pod_seq->cmd_name();
 503  
 504  The name of the interior sequence command.
 505  
 506  =cut
 507  
 508  sub cmd_name {
 509     (@_ > 1)  and  $_[0]->{'-name'} = $_[1];
 510     return $_[0]->{'-name'};
 511  }
 512  
 513  ## let name() be an alias for cmd_name()
 514  *name = \&cmd_name;
 515  
 516  ##---------------------------------------------------------------------------
 517  
 518  ## Private subroutine to set the parent pointer of all the given
 519  ## children that are interior-sequences to be $self
 520  
 521  sub _set_child2parent_links {
 522     my ($self, @children) = @_;
 523     ## Make sure any sequences know who their parent is
 524     for (@children) {
 525        next  unless (length  and  ref  and  ref ne 'SCALAR');
 526        if (UNIVERSAL::isa($_, 'Pod::InteriorSequence') or
 527            UNIVERSAL::can($_, 'nested'))
 528        {
 529            $_->nested($self);
 530        }
 531     }
 532  }
 533  
 534  ## Private subroutine to unset child->parent links
 535  
 536  sub _unset_child2parent_links {
 537     my $self = shift;
 538     $self->{'-parent_sequence'} = undef;
 539     my $ptree = $self->{'-ptree'};
 540     for (@$ptree) {
 541        next  unless (length  and  ref  and  ref ne 'SCALAR');
 542        $_->_unset_child2parent_links()
 543            if UNIVERSAL::isa($_, 'Pod::InteriorSequence');
 544     }
 545  }
 546  
 547  ##---------------------------------------------------------------------------
 548  
 549  =head2 $pod_seq-E<gt>B<prepend()>
 550  
 551          $pod_seq->prepend($text);
 552          $pod_seq1->prepend($pod_seq2);
 553  
 554  Prepends the given string or parse-tree or sequence object to the parse-tree
 555  of this interior sequence.
 556  
 557  =cut
 558  
 559  sub prepend {
 560     my $self  = shift;
 561     $self->{'-ptree'}->prepend(@_);
 562     _set_child2parent_links($self, @_);
 563     return $self;
 564  }       
 565  
 566  ##---------------------------------------------------------------------------
 567  
 568  =head2 $pod_seq-E<gt>B<append()>
 569  
 570          $pod_seq->append($text);
 571          $pod_seq1->append($pod_seq2);
 572  
 573  Appends the given string or parse-tree or sequence object to the parse-tree
 574  of this interior sequence.
 575  
 576  =cut
 577  
 578  sub append {
 579     my $self = shift;
 580     $self->{'-ptree'}->append(@_);
 581     _set_child2parent_links($self, @_);
 582     return $self;
 583  }       
 584  
 585  ##---------------------------------------------------------------------------
 586  
 587  =head2 $pod_seq-E<gt>B<nested()>
 588  
 589          $outer_seq = $pod_seq->nested || print "not nested";
 590  
 591  If this interior sequence is nested inside of another interior
 592  sequence, then the outer/parent sequence that contains it is
 593  returned. Otherwise C<undef> is returned.
 594  
 595  =cut
 596  
 597  sub nested {
 598     my $self = shift;
 599    (@_ == 1)  and  $self->{'-parent_sequence'} = shift;
 600     return  $self->{'-parent_sequence'} || undef;
 601  }
 602  
 603  ##---------------------------------------------------------------------------
 604  
 605  =head2 $pod_seq-E<gt>B<raw_text()>
 606  
 607          my $seq_raw_text = $pod_seq->raw_text();
 608  
 609  This method will return the I<raw> text of the POD interior sequence,
 610  exactly as it appeared in the input.
 611  
 612  =cut
 613  
 614  sub raw_text {
 615     my $self = shift;
 616     my $text = $self->{'-name'} . $self->{'-ldelim'};
 617     for ( $self->{'-ptree'}->children ) {
 618        $text .= (ref $_) ? $_->raw_text : $_;
 619     }
 620     $text .= $self->{'-rdelim'};
 621     return $text;
 622  }
 623  
 624  ##---------------------------------------------------------------------------
 625  
 626  =head2 $pod_seq-E<gt>B<left_delimiter()>
 627  
 628          my $ldelim = $pod_seq->left_delimiter();
 629  
 630  The leftmost delimiter beginning the argument text to the interior
 631  sequence (should be "<").
 632  
 633  =cut
 634  
 635  sub left_delimiter {
 636     (@_ > 1)  and  $_[0]->{'-ldelim'} = $_[1];
 637     return $_[0]->{'-ldelim'};
 638  }
 639  
 640  ## let ldelim() be an alias for left_delimiter()
 641  *ldelim = \&left_delimiter;
 642  
 643  ##---------------------------------------------------------------------------
 644  
 645  =head2 $pod_seq-E<gt>B<right_delimiter()>
 646  
 647  The rightmost delimiter beginning the argument text to the interior
 648  sequence (should be ">").
 649  
 650  =cut
 651  
 652  sub right_delimiter {
 653     (@_ > 1)  and  $_[0]->{'-rdelim'} = $_[1];
 654     return $_[0]->{'-rdelim'};
 655  }
 656  
 657  ## let rdelim() be an alias for right_delimiter()
 658  *rdelim = \&right_delimiter;
 659  
 660  ##---------------------------------------------------------------------------
 661  
 662  =head2 $pod_seq-E<gt>B<parse_tree()>
 663  
 664          my $ptree = $pod_parser->parse_text($paragraph_text);
 665          $pod_seq->parse_tree( $ptree );
 666          $ptree = $pod_seq->parse_tree();
 667  
 668  This method will get/set the corresponding parse-tree of the interior
 669  sequence's text.
 670  
 671  =cut
 672  
 673  sub parse_tree {
 674     (@_ > 1)  and  $_[0]->{'-ptree'} = $_[1];
 675     return $_[0]->{'-ptree'};
 676  }       
 677  
 678  ## let ptree() be an alias for parse_tree()
 679  *ptree = \&parse_tree;
 680  
 681  ##---------------------------------------------------------------------------
 682  
 683  =head2 $pod_seq-E<gt>B<file_line()>
 684  
 685          my ($filename, $line_number) = $pod_seq->file_line();
 686          my $position = $pod_seq->file_line();
 687  
 688  Returns the current filename and line number for the interior sequence
 689  object.  If called in a list context, it returns a list of two
 690  elements: first the filename, then the line number. If called in
 691  a scalar context, it returns a string containing the filename, followed
 692  by a colon (':'), followed by the line number.
 693  
 694  =cut
 695  
 696  sub file_line {
 697     my @loc = ($_[0]->{'-file'}  || '<unknown-file>',
 698                $_[0]->{'-line'}  || 0);
 699     return (wantarray) ? @loc : join(':', @loc);
 700  }
 701  
 702  ##---------------------------------------------------------------------------
 703  
 704  =head2 Pod::InteriorSequence::B<DESTROY()>
 705  
 706  This method performs any necessary cleanup for the interior-sequence.
 707  If you override this method then it is B<imperative> that you invoke
 708  the parent method from within your own method, otherwise
 709  I<interior-sequence storage will not be reclaimed upon destruction!>
 710  
 711  =cut
 712  
 713  sub DESTROY {
 714     ## We need to get rid of all child->parent pointers throughout the
 715     ## tree so their reference counts will go to zero and they can be
 716     ## garbage-collected
 717     _unset_child2parent_links(@_);
 718  }
 719  
 720  ##---------------------------------------------------------------------------
 721  
 722  #############################################################################
 723  
 724  package Pod::ParseTree;
 725  
 726  ##---------------------------------------------------------------------------
 727  
 728  =head1 B<Pod::ParseTree>
 729  
 730  This object corresponds to a tree of parsed POD text. As POD text is
 731  scanned from left to right, it is parsed into an ordered list of
 732  text-strings and B<Pod::InteriorSequence> objects (in order of
 733  appearance). A B<Pod::ParseTree> object corresponds to this list of
 734  strings and sequences. Each interior sequence in the parse-tree may
 735  itself contain a parse-tree (since interior sequences may be nested).
 736  
 737  =cut
 738  
 739  ##---------------------------------------------------------------------------
 740  
 741  =head2 Pod::ParseTree-E<gt>B<new()>
 742  
 743          my $ptree1 = Pod::ParseTree->new;
 744          my $ptree2 = new Pod::ParseTree;
 745          my $ptree4 = Pod::ParseTree->new($array_ref);
 746          my $ptree3 = new Pod::ParseTree($array_ref);
 747  
 748  This is a class method that constructs a C<Pod::Parse_tree> object and
 749  returns a reference to the new parse-tree. If a single-argument is given,
 750  it must be a reference to an array, and is used to initialize the root
 751  (top) of the parse tree.
 752  
 753  =cut
 754  
 755  sub new {
 756      ## Determine if we were called via an object-ref or a classname
 757      my $this = shift;
 758      my $class = ref($this) || $this;
 759  
 760      my $self = (@_ == 1  and  ref $_[0]) ? $_[0] : [];
 761  
 762      ## Bless ourselves into the desired class and perform any initialization
 763      bless $self, $class;
 764      return $self;
 765  }
 766  
 767  ##---------------------------------------------------------------------------
 768  
 769  =head2 $ptree-E<gt>B<top()>
 770  
 771          my $top_node = $ptree->top();
 772          $ptree->top( $top_node );
 773          $ptree->top( @children );
 774  
 775  This method gets/sets the top node of the parse-tree. If no arguments are
 776  given, it returns the topmost node in the tree (the root), which is also
 777  a B<Pod::ParseTree>. If it is given a single argument that is a reference,
 778  then the reference is assumed to a parse-tree and becomes the new top node.
 779  Otherwise, if arguments are given, they are treated as the new list of
 780  children for the top node.
 781  
 782  =cut
 783  
 784  sub top {
 785     my $self = shift;
 786     if (@_ > 0) {
 787        @{ $self } = (@_ == 1  and  ref $_[0]) ? ${ @_ } : @_;
 788     }
 789     return $self;
 790  }
 791  
 792  ## let parse_tree() & ptree() be aliases for the 'top' method
 793  *parse_tree = *ptree = \&top;
 794  
 795  ##---------------------------------------------------------------------------
 796  
 797  =head2 $ptree-E<gt>B<children()>
 798  
 799  This method gets/sets the children of the top node in the parse-tree.
 800  If no arguments are given, it returns the list (array) of children
 801  (each of which should be either a string or a B<Pod::InteriorSequence>.
 802  Otherwise, if arguments are given, they are treated as the new list of
 803  children for the top node.
 804  
 805  =cut
 806  
 807  sub children {
 808     my $self = shift;
 809     if (@_ > 0) {
 810        @{ $self } = (@_ == 1  and  ref $_[0]) ? ${ @_ } : @_;
 811     }
 812     return @{ $self };
 813  }
 814  
 815  ##---------------------------------------------------------------------------
 816  
 817  =head2 $ptree-E<gt>B<prepend()>
 818  
 819  This method prepends the given text or parse-tree to the current parse-tree.
 820  If the first item on the parse-tree is text and the argument is also text,
 821  then the text is prepended to the first item (not added as a separate string).
 822  Otherwise the argument is added as a new string or parse-tree I<before>
 823  the current one.
 824  
 825  =cut
 826  
 827  use vars qw(@ptree);  ## an alias used for performance reasons
 828  
 829  sub prepend {
 830     my $self = shift;
 831     local *ptree = $self;
 832     for (@_) {
 833        next  unless length;
 834        if (@ptree  and  !(ref $ptree[0])  and  !(ref $_)) {
 835           $ptree[0] = $_ . $ptree[0];
 836        }
 837        else {
 838           unshift @ptree, $_;
 839        }
 840     }
 841  }
 842  
 843  ##---------------------------------------------------------------------------
 844  
 845  =head2 $ptree-E<gt>B<append()>
 846  
 847  This method appends the given text or parse-tree to the current parse-tree.
 848  If the last item on the parse-tree is text and the argument is also text,
 849  then the text is appended to the last item (not added as a separate string).
 850  Otherwise the argument is added as a new string or parse-tree I<after>
 851  the current one.
 852  
 853  =cut
 854  
 855  sub append {
 856     my $self = shift;
 857     local *ptree = $self;
 858     my $can_append = @ptree && !(ref $ptree[-1]);
 859     for (@_) {
 860        if (ref) {
 861           push @ptree, $_;
 862        }
 863        elsif(!length) {
 864           next;
 865        }
 866        elsif ($can_append) {
 867           $ptree[-1] .= $_;
 868        }
 869        else {
 870           push @ptree, $_;
 871        }
 872     }
 873  }
 874  
 875  =head2 $ptree-E<gt>B<raw_text()>
 876  
 877          my $ptree_raw_text = $ptree->raw_text();
 878  
 879  This method will return the I<raw> text of the POD parse-tree
 880  exactly as it appeared in the input.
 881  
 882  =cut
 883  
 884  sub raw_text {
 885     my $self = shift;
 886     my $text = "";
 887     for ( @$self ) {
 888        $text .= (ref $_) ? $_->raw_text : $_;
 889     }
 890     return $text;
 891  }
 892  
 893  ##---------------------------------------------------------------------------
 894  
 895  ## Private routines to set/unset child->parent links
 896  
 897  sub _unset_child2parent_links {
 898     my $self = shift;
 899     local *ptree = $self;
 900     for (@ptree) {
 901         next  unless (defined and length  and  ref  and  ref ne 'SCALAR');
 902         $_->_unset_child2parent_links()
 903             if UNIVERSAL::isa($_, 'Pod::InteriorSequence');
 904     }
 905  }
 906  
 907  sub _set_child2parent_links {
 908      ## nothing to do, Pod::ParseTrees cant have parent pointers
 909  }
 910  
 911  =head2 Pod::ParseTree::B<DESTROY()>
 912  
 913  This method performs any necessary cleanup for the parse-tree.
 914  If you override this method then it is B<imperative>
 915  that you invoke the parent method from within your own method,
 916  otherwise I<parse-tree storage will not be reclaimed upon destruction!>
 917  
 918  =cut
 919  
 920  sub DESTROY {
 921     ## We need to get rid of all child->parent pointers throughout the
 922     ## tree so their reference counts will go to zero and they can be
 923     ## garbage-collected
 924     _unset_child2parent_links(@_);
 925  }
 926  
 927  #############################################################################
 928  
 929  =head1 SEE ALSO
 930  
 931  See L<Pod::Parser>, L<Pod::Select>
 932  
 933  =head1 AUTHOR
 934  
 935  Please report bugs using L<http://rt.cpan.org>.
 936  
 937  Brad Appleton E<lt>bradapp@enteract.comE<gt>
 938  
 939  =cut
 940  
 941  1;