This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
079a40bd5b2f5cb8d771457b7789e3dece4970c2
[perl5.git] / 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.13;  ## 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) ? $_[0] : 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    for (@_) {
859       next  unless length;
860       if (@ptree  and  !(ref $ptree[-1])  and  !(ref $_)) {
861          $ptree[-1] .= $_;
862       }
863       else {
864          push @ptree, $_;
865       }
866    }
867 }
868
869 =head2 $ptree-E<gt>B<raw_text()>
870
871         my $ptree_raw_text = $ptree->raw_text();
872
873 This method will return the I<raw> text of the POD parse-tree
874 exactly as it appeared in the input.
875
876 =cut
877
878 sub raw_text {
879    my $self = shift;
880    my $text = "";
881    for ( @$self ) {
882       $text .= (ref $_) ? $_->raw_text : $_;
883    }
884    return $text;
885 }
886
887 ##---------------------------------------------------------------------------
888
889 ## Private routines to set/unset child->parent links
890
891 sub _unset_child2parent_links {
892    my $self = shift;
893    local *ptree = $self;
894    for (@ptree) {
895        next  unless (length  and  ref  and  ref ne 'SCALAR');
896        $_->_unset_child2parent_links()
897            if UNIVERSAL::isa($_, 'Pod::InteriorSequence');
898    }
899 }
900
901 sub _set_child2parent_links {
902     ## nothing to do, Pod::ParseTrees cant have parent pointers
903 }
904
905 =head2 Pod::ParseTree::B<DESTROY()>
906
907 This method performs any necessary cleanup for the parse-tree.
908 If you override this method then it is B<imperative>
909 that you invoke the parent method from within your own method,
910 otherwise I<parse-tree storage will not be reclaimed upon destruction!>
911
912 =cut
913
914 sub DESTROY {
915    ## We need to get rid of all child->parent pointers throughout the
916    ## tree so their reference counts will go to zero and they can be
917    ## garbage-collected
918    _unset_child2parent_links(@_);
919 }
920
921 #############################################################################
922
923 =head1 SEE ALSO
924
925 See L<Pod::Parser>, L<Pod::Select>
926
927 =head1 AUTHOR
928
929 Brad Appleton E<lt>bradapp@enteract.comE<gt>
930
931 =cut
932
933 1;