[ Index ] |
PHP Cross Reference of Unnamed Project |
[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 = \⊤ 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;
title
Description
Body
title
Description
Body
title
Description
Body
title
Body
Generated: Tue Mar 17 22:47:18 2015 | Cross-referenced by PHPXref 0.7.1 |