Darwin is not Windows.
[p5sagit/p5-mst-13.2.git] / lib / Pod / InputObjects.pm
CommitLineData
360aca43 1#############################################################################
2# Pod/InputObjects.pm -- package which defines objects for input streams
3# and paragraphs and commands when parsing POD docs.
4#
66aff6dd 5# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved.
360aca43 6# This file is part of "PodParser". PodParser is free software;
7# you can redistribute it and/or modify it under the same terms
8# as Perl itself.
9#############################################################################
10
11package Pod::InputObjects;
12
13use vars qw($VERSION);
92e3d63a 14$VERSION = 1.13; ## Current version of this package
828c4421 15require 5.005; ## requires this Perl version or later
360aca43 16
17#############################################################################
18
19=head1 NAME
20
21Pod::InputObjects - objects representing POD input paragraphs, commands, etc.
22
23=head1 SYNOPSIS
24
25 use Pod::InputObjects;
26
27=head1 REQUIRES
28
29perl5.004, Carp
30
31=head1 EXPORTS
32
33Nothing.
34
35=head1 DESCRIPTION
36
37This module defines some basic input objects used by B<Pod::Parser> when
38reading and parsing POD text from an input source. The following objects
39are defined:
40
41=over 4
42
43=begin __PRIVATE__
44
92e3d63a 45=item package B<Pod::InputSource>
360aca43 46
47An object corresponding to a source of POD input text. It is mostly a
48wrapper around a filehandle or C<IO::Handle>-type object (or anything
49that implements the C<getline()> method) which keeps track of some
50additional information relevant to the parsing of PODs.
51
52=end __PRIVATE__
53
92e3d63a 54=item package B<Pod::Paragraph>
360aca43 55
56An object corresponding to a paragraph of POD input text. It may be a
57plain paragraph, a verbatim paragraph, or a command paragraph (see
58L<perlpod>).
59
92e3d63a 60=item package B<Pod::InteriorSequence>
360aca43 61
62An object corresponding to an interior sequence command from the POD
63input text (see L<perlpod>).
64
92e3d63a 65=item package B<Pod::ParseTree>
360aca43 66
67An object corresponding to a tree of parsed POD text. Each "node" in
68a parse-tree (or I<ptree>) is either a text-string or a reference to
69a B<Pod::InteriorSequence> object. The nodes appear in the parse-tree
92e3d63a 70in the order in which they were parsed from left-to-right.
360aca43 71
72=back
73
74Each of these input objects are described in further detail in the
75sections which follow.
76
77=cut
78
79#############################################################################
80
81use strict;
82#use diagnostics;
83#use Carp;
84
85#############################################################################
86
87package Pod::InputSource;
88
89##---------------------------------------------------------------------------
90
91=begin __PRIVATE__
92
93=head1 B<Pod::InputSource>
94
95This object corresponds to an input source or stream of POD
96documentation. When parsing PODs, it is necessary to associate and store
97certain context information with each input source. All of this
98information is kept together with the stream itself in one of these
99C<Pod::InputSource> objects. Each such object is merely a wrapper around
100an C<IO::Handle> object of some kind (or at least something that
101implements the C<getline()> method). They have the following
102methods/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
121This is a class method that constructs a C<Pod::InputSource> object and
122returns a reference to the new input source object. It takes one or more
123keyword arguments in the form of a hash. The keyword C<-handle> is
124required and designates the corresponding input handle. The keyword
125C<-name> is optional and specifies the name associated with the input
126handle (typically a file name).
127
128=end __PRIVATE__
129
130=cut
131
132sub 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
160This method gets/sets the name of the input source (usually a filename).
161If no argument is given, it returns a string containing the name of
162the input source; otherwise it sets the name of the input source to the
163contents of the given argument.
164
165=end __PRIVATE__
166
167=cut
168
169sub 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
185Returns a reference to the handle object from which input is read (the
186one used to contructed this input source object).
187
188=end __PRIVATE__
189
190=cut
191
192sub 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
204The value of the C<cutting> state (that the B<cutting()> method would
205have returned) immediately before any input was read from this input
206stream. After all input from this stream has been read, the C<cutting>
207state is restored to this value.
208
209=end __PRIVATE__
210
211=cut
212
213sub was_cutting {
214 (@_ > 1) and $_[0]->{-was_cutting} = $_[1];
215 return $_[0]->{-was_cutting};
216}
217
218##---------------------------------------------------------------------------
219
220#############################################################################
221
222package Pod::Paragraph;
223
224##---------------------------------------------------------------------------
225
226=head1 B<Pod::Paragraph>
227
228An object representing a paragraph of POD input text.
229It has the following methods/attributes:
230
231=cut
232
233##---------------------------------------------------------------------------
234
92e3d63a 235=head2 Pod::Paragraph-E<gt>B<new()>
360aca43 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
248This is a class method that constructs a C<Pod::Paragraph> object and
249returns a reference to the new paragraph object. It may be given one or
250two keyword arguments. The C<-text> keyword indicates the corresponding
251text of the POD paragraph. The C<-name> keyword indicates the name of
252the corresponding POD command, such as C<head1> or C<item> (it should
253I<not> contain the C<=> prefix); this is needed only if the POD
254paragraph corresponds to a command paragraph. The C<-file> and C<-line>
255keywords indicate the filename and line number corresponding to the
256beginning of the paragraph
257
258=cut
259
260sub 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
92e3d63a 287=head2 $pod_para-E<gt>B<cmd_name()>
360aca43 288
289 my $para_cmd = $pod_para->cmd_name();
290
291If this paragraph is a command paragraph, then this method will return
292the name of the command (I<without> any leading C<=> prefix).
293
294=cut
295
296sub 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
92e3d63a 306=head2 $pod_para-E<gt>B<text()>
360aca43 307
308 my $para_text = $pod_para->text();
309
310This method will return the corresponding text of the paragraph.
311
312=cut
313
314sub text {
315 (@_ > 1) and $_[0]->{'-text'} = $_[1];
316 return $_[0]->{'-text'};
317}
318
319##---------------------------------------------------------------------------
320
92e3d63a 321=head2 $pod_para-E<gt>B<raw_text()>
360aca43 322
323 my $raw_pod_para = $pod_para->raw_text();
324
325This method will return the I<raw> text of the POD paragraph, exactly
326as it appeared in the input.
327
328=cut
329
330sub 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
92e3d63a 338=head2 $pod_para-E<gt>B<cmd_prefix()>
360aca43 339
340 my $prefix = $pod_para->cmd_prefix();
341
342If this paragraph is a command paragraph, then this method will return
343the prefix used to denote the command (which should be the string "="
344or "==").
345
346=cut
347
348sub cmd_prefix {
349 return $_[0]->{'-prefix'};
350}
351
352##---------------------------------------------------------------------------
353
92e3d63a 354=head2 $pod_para-E<gt>B<cmd_separator()>
360aca43 355
356 my $separator = $pod_para->cmd_separator();
357
358If this paragraph is a command paragraph, then this method will return
359the text used to separate the command name from the rest of the
360paragraph (if any).
361
362=cut
363
364sub cmd_separator {
365 return $_[0]->{'-separator'};
366}
367
368##---------------------------------------------------------------------------
369
92e3d63a 370=head2 $pod_para-E<gt>B<parse_tree()>
360aca43 371
372 my $ptree = $pod_parser->parse_text( $pod_para->text() );
373 $pod_para->parse_tree( $ptree );
374 $ptree = $pod_para->parse_tree();
375
376This method will get/set the corresponding parse-tree of the paragraph's text.
377
378=cut
379
380sub 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
92e3d63a 390=head2 $pod_para-E<gt>B<file_line()>
360aca43 391
392 my ($filename, $line_number) = $pod_para->file_line();
393 my $position = $pod_para->file_line();
394
395Returns the current filename and line number for the paragraph
f9a1036d 396object. If called in a list context, it returns a list of two
360aca43 397elements: first the filename, then the line number. If called in
398a scalar context, it returns a string containing the filename, followed
399by a colon (':'), followed by the line number.
400
401=cut
402
403sub 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
413package Pod::InteriorSequence;
414
415##---------------------------------------------------------------------------
416
417=head1 B<Pod::InteriorSequence>
418
419An object representing a POD interior sequence command.
420It has the following methods/attributes:
421
422=cut
423
424##---------------------------------------------------------------------------
425
92e3d63a 426=head2 Pod::InteriorSequence-E<gt>B<new()>
360aca43 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
664bb207 437 my $pod_seq4 = new Pod::InteriorSequence(-name => $cmd, $ptree);
438 my $pod_seq5 = new Pod::InteriorSequence($cmd, $ptree);
439
360aca43 440This is a class method that constructs a C<Pod::InteriorSequence> object
441and returns a reference to the new interior sequence object. It should
442be given two keyword arguments. The C<-ldelim> keyword indicates the
443corresponding left-delimiter of the interior sequence (e.g. 'E<lt>').
444The C<-name> keyword indicates the name of the corresponding interior
445sequence command, such as C<I> or C<B> or C<C>. The C<-file> and
446C<-line> keywords indicate the filename and line number corresponding
664bb207 447to the beginning of the interior sequence. If the C<$ptree> argument is
448given, it must be the last argument, and it must be either string, or
449else an array-ref suitable for passing to B<Pod::ParseTree::new> (or
450it may be a reference to an Pod::ParseTree object).
360aca43 451
452=cut
453
454sub 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
664bb207 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
360aca43 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 => '>',
360aca43 481 @_
482 };
483
664bb207 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
360aca43 493 ## Bless ourselves into the desired class and perform any initialization
494 bless $self, $class;
495 return $self;
496}
497
498##---------------------------------------------------------------------------
499
92e3d63a 500=head2 $pod_seq-E<gt>B<cmd_name()>
360aca43 501
502 my $seq_cmd = $pod_seq->cmd_name();
503
504The name of the interior sequence command.
505
506=cut
507
508sub 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
521sub _set_child2parent_links {
522 my ($self, @children) = @_;
523 ## Make sure any sequences know who their parent is
524 for (@children) {
828c4421 525 next unless (length and ref and ref ne 'SCALAR');
e23b9d0f 526 if (UNIVERSAL::isa($_, 'Pod::InteriorSequence') or
527 UNIVERSAL::can($_, 'nested'))
528 {
360aca43 529 $_->nested($self);
530 }
531 }
532}
533
534## Private subroutine to unset child->parent links
535
536sub _unset_child2parent_links {
537 my $self = shift;
538 $self->{'-parent_sequence'} = undef;
539 my $ptree = $self->{'-ptree'};
540 for (@$ptree) {
664bb207 541 next unless (length and ref and ref ne 'SCALAR');
e23b9d0f 542 $_->_unset_child2parent_links()
543 if UNIVERSAL::isa($_, 'Pod::InteriorSequence');
360aca43 544 }
545}
546
547##---------------------------------------------------------------------------
548
92e3d63a 549=head2 $pod_seq-E<gt>B<prepend()>
360aca43 550
551 $pod_seq->prepend($text);
552 $pod_seq1->prepend($pod_seq2);
553
554Prepends the given string or parse-tree or sequence object to the parse-tree
555of this interior sequence.
556
557=cut
558
559sub prepend {
560 my $self = shift;
561 $self->{'-ptree'}->prepend(@_);
562 _set_child2parent_links($self, @_);
563 return $self;
564}
565
566##---------------------------------------------------------------------------
567
92e3d63a 568=head2 $pod_seq-E<gt>B<append()>
360aca43 569
570 $pod_seq->append($text);
571 $pod_seq1->append($pod_seq2);
572
573Appends the given string or parse-tree or sequence object to the parse-tree
574of this interior sequence.
575
576=cut
577
578sub append {
579 my $self = shift;
580 $self->{'-ptree'}->append(@_);
581 _set_child2parent_links($self, @_);
582 return $self;
583}
584
585##---------------------------------------------------------------------------
586
92e3d63a 587=head2 $pod_seq-E<gt>B<nested()>
360aca43 588
589 $outer_seq = $pod_seq->nested || print "not nested";
590
591If this interior sequence is nested inside of another interior
592sequence, then the outer/parent sequence that contains it is
593returned. Otherwise C<undef> is returned.
594
595=cut
596
597sub nested {
598 my $self = shift;
599 (@_ == 1) and $self->{'-parent_sequence'} = shift;
600 return $self->{'-parent_sequence'} || undef;
601}
602
603##---------------------------------------------------------------------------
604
92e3d63a 605=head2 $pod_seq-E<gt>B<raw_text()>
360aca43 606
607 my $seq_raw_text = $pod_seq->raw_text();
608
609This method will return the I<raw> text of the POD interior sequence,
610exactly as it appeared in the input.
611
612=cut
613
614sub 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
92e3d63a 626=head2 $pod_seq-E<gt>B<left_delimiter()>
360aca43 627
628 my $ldelim = $pod_seq->left_delimiter();
629
630The leftmost delimiter beginning the argument text to the interior
631sequence (should be "<").
632
633=cut
634
635sub 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
92e3d63a 645=head2 $pod_seq-E<gt>B<right_delimiter()>
360aca43 646
647The rightmost delimiter beginning the argument text to the interior
648sequence (should be ">").
649
650=cut
651
652sub 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
92e3d63a 662=head2 $pod_seq-E<gt>B<parse_tree()>
360aca43 663
664 my $ptree = $pod_parser->parse_text($paragraph_text);
665 $pod_seq->parse_tree( $ptree );
666 $ptree = $pod_seq->parse_tree();
667
668This method will get/set the corresponding parse-tree of the interior
669sequence's text.
670
671=cut
672
673sub 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
92e3d63a 683=head2 $pod_seq-E<gt>B<file_line()>
360aca43 684
685 my ($filename, $line_number) = $pod_seq->file_line();
686 my $position = $pod_seq->file_line();
687
688Returns the current filename and line number for the interior sequence
f9a1036d 689object. If called in a list context, it returns a list of two
360aca43 690elements: first the filename, then the line number. If called in
691a scalar context, it returns a string containing the filename, followed
692by a colon (':'), followed by the line number.
693
694=cut
695
696sub file_line {
697 my @loc = ($_[0]->{'-file'} || '<unknown-file>',
698 $_[0]->{'-line'} || 0);
699 return (wantarray) ? @loc : join(':', @loc);
700}
701
702##---------------------------------------------------------------------------
703
92e3d63a 704=head2 Pod::InteriorSequence::B<DESTROY()>
360aca43 705
706This method performs any necessary cleanup for the interior-sequence.
707If you override this method then it is B<imperative> that you invoke
708the parent method from within your own method, otherwise
709I<interior-sequence storage will not be reclaimed upon destruction!>
710
711=cut
712
713sub 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
724package Pod::ParseTree;
725
726##---------------------------------------------------------------------------
727
728=head1 B<Pod::ParseTree>
729
730This object corresponds to a tree of parsed POD text. As POD text is
731scanned from left to right, it is parsed into an ordered list of
732text-strings and B<Pod::InteriorSequence> objects (in order of
733appearance). A B<Pod::ParseTree> object corresponds to this list of
734strings and sequences. Each interior sequence in the parse-tree may
735itself contain a parse-tree (since interior sequences may be nested).
736
737=cut
738
739##---------------------------------------------------------------------------
740
92e3d63a 741=head2 Pod::ParseTree-E<gt>B<new()>
360aca43 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
748This is a class method that constructs a C<Pod::Parse_tree> object and
749returns a reference to the new parse-tree. If a single-argument is given,
664bb207 750it must be a reference to an array, and is used to initialize the root
360aca43 751(top) of the parse tree.
752
753=cut
754
755sub 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
92e3d63a 769=head2 $ptree-E<gt>B<top()>
360aca43 770
771 my $top_node = $ptree->top();
772 $ptree->top( $top_node );
773 $ptree->top( @children );
774
775This method gets/sets the top node of the parse-tree. If no arguments are
776given, it returns the topmost node in the tree (the root), which is also
777a B<Pod::ParseTree>. If it is given a single argument that is a reference,
778then the reference is assumed to a parse-tree and becomes the new top node.
779Otherwise, if arguments are given, they are treated as the new list of
780children for the top node.
781
782=cut
783
784sub 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
92e3d63a 797=head2 $ptree-E<gt>B<children()>
360aca43 798
799This method gets/sets the children of the top node in the parse-tree.
800If 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>.
802Otherwise, if arguments are given, they are treated as the new list of
803children for the top node.
804
805=cut
806
807sub children {
808 my $self = shift;
809 if (@_ > 0) {
810 @{ $self } = (@_ == 1 and ref $_[0]) ? ${ @_ } : @_;
811 }
812 return @{ $self };
813}
814
815##---------------------------------------------------------------------------
816
92e3d63a 817=head2 $ptree-E<gt>B<prepend()>
360aca43 818
819This method prepends the given text or parse-tree to the current parse-tree.
820If the first item on the parse-tree is text and the argument is also text,
821then the text is prepended to the first item (not added as a separate string).
822Otherwise the argument is added as a new string or parse-tree I<before>
823the current one.
824
825=cut
826
827use vars qw(@ptree); ## an alias used for performance reasons
828
829sub prepend {
830 my $self = shift;
831 local *ptree = $self;
832 for (@_) {
e9fdc7d2 833 next unless length;
360aca43 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
92e3d63a 845=head2 $ptree-E<gt>B<append()>
360aca43 846
847This method appends the given text or parse-tree to the current parse-tree.
848If the last item on the parse-tree is text and the argument is also text,
849then the text is appended to the last item (not added as a separate string).
850Otherwise the argument is added as a new string or parse-tree I<after>
851the current one.
852
853=cut
854
855sub append {
856 my $self = shift;
857 local *ptree = $self;
858 for (@_) {
e9fdc7d2 859 next unless length;
360aca43 860 if (@ptree and !(ref $ptree[-1]) and !(ref $_)) {
861 $ptree[-1] .= $_;
862 }
863 else {
864 push @ptree, $_;
865 }
866 }
867}
868
92e3d63a 869=head2 $ptree-E<gt>B<raw_text()>
360aca43 870
871 my $ptree_raw_text = $ptree->raw_text();
872
873This method will return the I<raw> text of the POD parse-tree
874exactly as it appeared in the input.
875
876=cut
877
878sub 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
891sub _unset_child2parent_links {
892 my $self = shift;
893 local *ptree = $self;
894 for (@ptree) {
664bb207 895 next unless (length and ref and ref ne 'SCALAR');
e23b9d0f 896 $_->_unset_child2parent_links()
897 if UNIVERSAL::isa($_, 'Pod::InteriorSequence');
360aca43 898 }
899}
900
901sub _set_child2parent_links {
902 ## nothing to do, Pod::ParseTrees cant have parent pointers
903}
904
92e3d63a 905=head2 Pod::ParseTree::B<DESTROY()>
360aca43 906
907This method performs any necessary cleanup for the parse-tree.
908If you override this method then it is B<imperative>
909that you invoke the parent method from within your own method,
910otherwise I<parse-tree storage will not be reclaimed upon destruction!>
911
912=cut
913
914sub 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
828c4421 925See L<Pod::Parser>, L<Pod::Select>
360aca43 926
927=head1 AUTHOR
928
929Brad Appleton E<lt>bradapp@enteract.comE<gt>
930
931=cut
932
9331;