lib/Pod/InputObjects.pm

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