File Coverage

blib/lib/Pod/InputObjects.pm
Criterion Covered Total %
statement 0 124 0.0
branch 0 74 0.0
condition 0 73 0.0
subroutine 0 34 0.0
pod n/a
total 0 305 0.0


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