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