ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cvsroot/staticperl/perl/lib/Pod/InputObjects.pm
Revision: 1.1
Committed: Thu Jun 30 14:27:14 2005 UTC (21 years, 3 months ago) by root
Branch: MAIN
CVS Tags: PERL-5-8-7, HEAD
Branch point for: PERL
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.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;