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
  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;