Commit | Line | Data |
360aca43 |
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-1999 Tom Christiansen. 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); |
e9fdc7d2 |
14 | $VERSION = 1.081; ## Current version of this package |
360aca43 |
15 | require 5.004; ## 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 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 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 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 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 they 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 B<new()> |
236 | |
237 | my $pod_para1 = Pod::Paragraph->new(-text => $text); |
238 | my $pod_para2 = Pod::Paragraph->new(-name => $cmd, |
239 | -text => $text); |
240 | my $pod_para3 = new Pod::Paragraph(-text => $text); |
241 | my $pod_para4 = new Pod::Paragraph(-name => $cmd, |
242 | -text => $text); |
243 | my $pod_para5 = Pod::Paragraph->new(-name => $cmd, |
244 | -text => $text, |
245 | -file => $filename, |
246 | -line => $line_number); |
247 | |
248 | This is a class method that constructs a C<Pod::Paragraph> object and |
249 | returns a reference to the new paragraph object. It may be given one or |
250 | two keyword arguments. The C<-text> keyword indicates the corresponding |
251 | text of the POD paragraph. The C<-name> keyword indicates the name of |
252 | the corresponding POD command, such as C<head1> or C<item> (it should |
253 | I<not> contain the C<=> prefix); this is needed only if the POD |
254 | paragraph corresponds to a command paragraph. The C<-file> and C<-line> |
255 | keywords indicate the filename and line number corresponding to the |
256 | beginning of the paragraph |
257 | |
258 | =cut |
259 | |
260 | sub new { |
261 | ## Determine if we were called via an object-ref or a classname |
262 | my $this = shift; |
263 | my $class = ref($this) || $this; |
264 | |
265 | ## Any remaining arguments are treated as initial values for the |
266 | ## hash that is used to represent this object. Note that we default |
267 | ## certain values by specifying them *before* the arguments passed. |
268 | ## If they are in the argument list, they will override the defaults. |
269 | my $self = { |
270 | -name => undef, |
271 | -text => (@_ == 1) ? $_[0] : undef, |
272 | -file => '<unknown-file>', |
273 | -line => 0, |
274 | -prefix => '=', |
275 | -separator => ' ', |
276 | -ptree => [], |
277 | @_ |
278 | }; |
279 | |
280 | ## Bless ourselves into the desired class and perform any initialization |
281 | bless $self, $class; |
282 | return $self; |
283 | } |
284 | |
285 | ##--------------------------------------------------------------------------- |
286 | |
287 | =head2 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 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 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 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 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 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 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 an array 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 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 | This is a class method that constructs a C<Pod::InteriorSequence> object |
438 | and returns a reference to the new interior sequence object. It should |
439 | be given two keyword arguments. The C<-ldelim> keyword indicates the |
440 | corresponding left-delimiter of the interior sequence (e.g. 'E<lt>'). |
441 | The C<-name> keyword indicates the name of the corresponding interior |
442 | sequence command, such as C<I> or C<B> or C<C>. The C<-file> and |
443 | C<-line> keywords indicate the filename and line number corresponding |
444 | to the beginning of the interior sequence. |
445 | |
446 | =cut |
447 | |
448 | sub new { |
449 | ## Determine if we were called via an object-ref or a classname |
450 | my $this = shift; |
451 | my $class = ref($this) || $this; |
452 | |
453 | ## Any remaining arguments are treated as initial values for the |
454 | ## hash that is used to represent this object. Note that we default |
455 | ## certain values by specifying them *before* the arguments passed. |
456 | ## If they are in the argument list, they will override the defaults. |
457 | my $self = { |
458 | -name => (@_ == 1) ? $_[0] : undef, |
459 | -file => '<unknown-file>', |
460 | -line => 0, |
461 | -ldelim => '<', |
462 | -rdelim => '>', |
463 | -ptree => new Pod::ParseTree(), |
464 | @_ |
465 | }; |
466 | |
467 | ## Bless ourselves into the desired class and perform any initialization |
468 | bless $self, $class; |
469 | return $self; |
470 | } |
471 | |
472 | ##--------------------------------------------------------------------------- |
473 | |
474 | =head2 B<cmd_name()> |
475 | |
476 | my $seq_cmd = $pod_seq->cmd_name(); |
477 | |
478 | The name of the interior sequence command. |
479 | |
480 | =cut |
481 | |
482 | sub cmd_name { |
483 | (@_ > 1) and $_[0]->{'-name'} = $_[1]; |
484 | return $_[0]->{'-name'}; |
485 | } |
486 | |
487 | ## let name() be an alias for cmd_name() |
488 | *name = \&cmd_name; |
489 | |
490 | ##--------------------------------------------------------------------------- |
491 | |
492 | ## Private subroutine to set the parent pointer of all the given |
493 | ## children that are interior-sequences to be $self |
494 | |
495 | sub _set_child2parent_links { |
496 | my ($self, @children) = @_; |
497 | ## Make sure any sequences know who their parent is |
498 | for (@children) { |
e9fdc7d2 |
499 | next unless ref; |
360aca43 |
500 | if ($_->isa('Pod::InteriorSequence') or $_->can('nested')) { |
501 | $_->nested($self); |
502 | } |
503 | } |
504 | } |
505 | |
506 | ## Private subroutine to unset child->parent links |
507 | |
508 | sub _unset_child2parent_links { |
509 | my $self = shift; |
510 | $self->{'-parent_sequence'} = undef; |
511 | my $ptree = $self->{'-ptree'}; |
512 | for (@$ptree) { |
e9fdc7d2 |
513 | next unless (length and ref and $_->isa('Pod::InteriorSequence')); |
360aca43 |
514 | $_->_unset_child2parent_links(); |
515 | } |
516 | } |
517 | |
518 | ##--------------------------------------------------------------------------- |
519 | |
520 | =head2 B<prepend()> |
521 | |
522 | $pod_seq->prepend($text); |
523 | $pod_seq1->prepend($pod_seq2); |
524 | |
525 | Prepends the given string or parse-tree or sequence object to the parse-tree |
526 | of this interior sequence. |
527 | |
528 | =cut |
529 | |
530 | sub prepend { |
531 | my $self = shift; |
532 | $self->{'-ptree'}->prepend(@_); |
533 | _set_child2parent_links($self, @_); |
534 | return $self; |
535 | } |
536 | |
537 | ##--------------------------------------------------------------------------- |
538 | |
539 | =head2 B<append()> |
540 | |
541 | $pod_seq->append($text); |
542 | $pod_seq1->append($pod_seq2); |
543 | |
544 | Appends the given string or parse-tree or sequence object to the parse-tree |
545 | of this interior sequence. |
546 | |
547 | =cut |
548 | |
549 | sub append { |
550 | my $self = shift; |
551 | $self->{'-ptree'}->append(@_); |
552 | _set_child2parent_links($self, @_); |
553 | return $self; |
554 | } |
555 | |
556 | ##--------------------------------------------------------------------------- |
557 | |
558 | =head2 B<nested()> |
559 | |
560 | $outer_seq = $pod_seq->nested || print "not nested"; |
561 | |
562 | If this interior sequence is nested inside of another interior |
563 | sequence, then the outer/parent sequence that contains it is |
564 | returned. Otherwise C<undef> is returned. |
565 | |
566 | =cut |
567 | |
568 | sub nested { |
569 | my $self = shift; |
570 | (@_ == 1) and $self->{'-parent_sequence'} = shift; |
571 | return $self->{'-parent_sequence'} || undef; |
572 | } |
573 | |
574 | ##--------------------------------------------------------------------------- |
575 | |
576 | =head2 B<raw_text()> |
577 | |
578 | my $seq_raw_text = $pod_seq->raw_text(); |
579 | |
580 | This method will return the I<raw> text of the POD interior sequence, |
581 | exactly as it appeared in the input. |
582 | |
583 | =cut |
584 | |
585 | sub raw_text { |
586 | my $self = shift; |
587 | my $text = $self->{'-name'} . $self->{'-ldelim'}; |
588 | for ( $self->{'-ptree'}->children ) { |
589 | $text .= (ref $_) ? $_->raw_text : $_; |
590 | } |
591 | $text .= $self->{'-rdelim'}; |
592 | return $text; |
593 | } |
594 | |
595 | ##--------------------------------------------------------------------------- |
596 | |
597 | =head2 B<left_delimiter()> |
598 | |
599 | my $ldelim = $pod_seq->left_delimiter(); |
600 | |
601 | The leftmost delimiter beginning the argument text to the interior |
602 | sequence (should be "<"). |
603 | |
604 | =cut |
605 | |
606 | sub left_delimiter { |
607 | (@_ > 1) and $_[0]->{'-ldelim'} = $_[1]; |
608 | return $_[0]->{'-ldelim'}; |
609 | } |
610 | |
611 | ## let ldelim() be an alias for left_delimiter() |
612 | *ldelim = \&left_delimiter; |
613 | |
614 | ##--------------------------------------------------------------------------- |
615 | |
616 | =head2 B<right_delimiter()> |
617 | |
618 | The rightmost delimiter beginning the argument text to the interior |
619 | sequence (should be ">"). |
620 | |
621 | =cut |
622 | |
623 | sub right_delimiter { |
624 | (@_ > 1) and $_[0]->{'-rdelim'} = $_[1]; |
625 | return $_[0]->{'-rdelim'}; |
626 | } |
627 | |
628 | ## let rdelim() be an alias for right_delimiter() |
629 | *rdelim = \&right_delimiter; |
630 | |
631 | ##--------------------------------------------------------------------------- |
632 | |
633 | =head2 B<parse_tree()> |
634 | |
635 | my $ptree = $pod_parser->parse_text($paragraph_text); |
636 | $pod_seq->parse_tree( $ptree ); |
637 | $ptree = $pod_seq->parse_tree(); |
638 | |
639 | This method will get/set the corresponding parse-tree of the interior |
640 | sequence's text. |
641 | |
642 | =cut |
643 | |
644 | sub parse_tree { |
645 | (@_ > 1) and $_[0]->{'-ptree'} = $_[1]; |
646 | return $_[0]->{'-ptree'}; |
647 | } |
648 | |
649 | ## let ptree() be an alias for parse_tree() |
650 | *ptree = \&parse_tree; |
651 | |
652 | ##--------------------------------------------------------------------------- |
653 | |
654 | =head2 B<file_line()> |
655 | |
656 | my ($filename, $line_number) = $pod_seq->file_line(); |
657 | my $position = $pod_seq->file_line(); |
658 | |
659 | Returns the current filename and line number for the interior sequence |
660 | object. If called in an array context, it returns a list of two |
661 | elements: first the filename, then the line number. If called in |
662 | a scalar context, it returns a string containing the filename, followed |
663 | by a colon (':'), followed by the line number. |
664 | |
665 | =cut |
666 | |
667 | sub file_line { |
668 | my @loc = ($_[0]->{'-file'} || '<unknown-file>', |
669 | $_[0]->{'-line'} || 0); |
670 | return (wantarray) ? @loc : join(':', @loc); |
671 | } |
672 | |
673 | ##--------------------------------------------------------------------------- |
674 | |
675 | =head2 B<DESTROY()> |
676 | |
677 | This method performs any necessary cleanup for the interior-sequence. |
678 | If you override this method then it is B<imperative> that you invoke |
679 | the parent method from within your own method, otherwise |
680 | I<interior-sequence storage will not be reclaimed upon destruction!> |
681 | |
682 | =cut |
683 | |
684 | sub DESTROY { |
685 | ## We need to get rid of all child->parent pointers throughout the |
686 | ## tree so their reference counts will go to zero and they can be |
687 | ## garbage-collected |
688 | _unset_child2parent_links(@_); |
689 | } |
690 | |
691 | ##--------------------------------------------------------------------------- |
692 | |
693 | ############################################################################# |
694 | |
695 | package Pod::ParseTree; |
696 | |
697 | ##--------------------------------------------------------------------------- |
698 | |
699 | =head1 B<Pod::ParseTree> |
700 | |
701 | This object corresponds to a tree of parsed POD text. As POD text is |
702 | scanned from left to right, it is parsed into an ordered list of |
703 | text-strings and B<Pod::InteriorSequence> objects (in order of |
704 | appearance). A B<Pod::ParseTree> object corresponds to this list of |
705 | strings and sequences. Each interior sequence in the parse-tree may |
706 | itself contain a parse-tree (since interior sequences may be nested). |
707 | |
708 | =cut |
709 | |
710 | ##--------------------------------------------------------------------------- |
711 | |
712 | =head2 B<new()> |
713 | |
714 | my $ptree1 = Pod::ParseTree->new; |
715 | my $ptree2 = new Pod::ParseTree; |
716 | my $ptree4 = Pod::ParseTree->new($array_ref); |
717 | my $ptree3 = new Pod::ParseTree($array_ref); |
718 | |
719 | This is a class method that constructs a C<Pod::Parse_tree> object and |
720 | returns a reference to the new parse-tree. If a single-argument is given, |
721 | it mist be a reference to an array, and is used to initialize the root |
722 | (top) of the parse tree. |
723 | |
724 | =cut |
725 | |
726 | sub new { |
727 | ## Determine if we were called via an object-ref or a classname |
728 | my $this = shift; |
729 | my $class = ref($this) || $this; |
730 | |
731 | my $self = (@_ == 1 and ref $_[0]) ? $_[0] : []; |
732 | |
733 | ## Bless ourselves into the desired class and perform any initialization |
734 | bless $self, $class; |
735 | return $self; |
736 | } |
737 | |
738 | ##--------------------------------------------------------------------------- |
739 | |
740 | =head2 B<top()> |
741 | |
742 | my $top_node = $ptree->top(); |
743 | $ptree->top( $top_node ); |
744 | $ptree->top( @children ); |
745 | |
746 | This method gets/sets the top node of the parse-tree. If no arguments are |
747 | given, it returns the topmost node in the tree (the root), which is also |
748 | a B<Pod::ParseTree>. If it is given a single argument that is a reference, |
749 | then the reference is assumed to a parse-tree and becomes the new top node. |
750 | Otherwise, if arguments are given, they are treated as the new list of |
751 | children for the top node. |
752 | |
753 | =cut |
754 | |
755 | sub top { |
756 | my $self = shift; |
757 | if (@_ > 0) { |
758 | @{ $self } = (@_ == 1 and ref $_[0]) ? ${ @_ } : @_; |
759 | } |
760 | return $self; |
761 | } |
762 | |
763 | ## let parse_tree() & ptree() be aliases for the 'top' method |
764 | *parse_tree = *ptree = \⊤ |
765 | |
766 | ##--------------------------------------------------------------------------- |
767 | |
768 | =head2 B<children()> |
769 | |
770 | This method gets/sets the children of the top node in the parse-tree. |
771 | If no arguments are given, it returns the list (array) of children |
772 | (each of which should be either a string or a B<Pod::InteriorSequence>. |
773 | Otherwise, if arguments are given, they are treated as the new list of |
774 | children for the top node. |
775 | |
776 | =cut |
777 | |
778 | sub children { |
779 | my $self = shift; |
780 | if (@_ > 0) { |
781 | @{ $self } = (@_ == 1 and ref $_[0]) ? ${ @_ } : @_; |
782 | } |
783 | return @{ $self }; |
784 | } |
785 | |
786 | ##--------------------------------------------------------------------------- |
787 | |
788 | =head2 B<prepend()> |
789 | |
790 | This method prepends the given text or parse-tree to the current parse-tree. |
791 | If the first item on the parse-tree is text and the argument is also text, |
792 | then the text is prepended to the first item (not added as a separate string). |
793 | Otherwise the argument is added as a new string or parse-tree I<before> |
794 | the current one. |
795 | |
796 | =cut |
797 | |
798 | use vars qw(@ptree); ## an alias used for performance reasons |
799 | |
800 | sub prepend { |
801 | my $self = shift; |
802 | local *ptree = $self; |
803 | for (@_) { |
e9fdc7d2 |
804 | next unless length; |
360aca43 |
805 | if (@ptree and !(ref $ptree[0]) and !(ref $_)) { |
806 | $ptree[0] = $_ . $ptree[0]; |
807 | } |
808 | else { |
809 | unshift @ptree, $_; |
810 | } |
811 | } |
812 | } |
813 | |
814 | ##--------------------------------------------------------------------------- |
815 | |
816 | =head2 B<append()> |
817 | |
818 | This method appends the given text or parse-tree to the current parse-tree. |
819 | If the last item on the parse-tree is text and the argument is also text, |
820 | then the text is appended to the last item (not added as a separate string). |
821 | Otherwise the argument is added as a new string or parse-tree I<after> |
822 | the current one. |
823 | |
824 | =cut |
825 | |
826 | sub append { |
827 | my $self = shift; |
828 | local *ptree = $self; |
829 | for (@_) { |
e9fdc7d2 |
830 | next unless length; |
360aca43 |
831 | if (@ptree and !(ref $ptree[-1]) and !(ref $_)) { |
832 | $ptree[-1] .= $_; |
833 | } |
834 | else { |
835 | push @ptree, $_; |
836 | } |
837 | } |
838 | } |
839 | |
840 | =head2 B<raw_text()> |
841 | |
842 | my $ptree_raw_text = $ptree->raw_text(); |
843 | |
844 | This method will return the I<raw> text of the POD parse-tree |
845 | exactly as it appeared in the input. |
846 | |
847 | =cut |
848 | |
849 | sub raw_text { |
850 | my $self = shift; |
851 | my $text = ""; |
852 | for ( @$self ) { |
853 | $text .= (ref $_) ? $_->raw_text : $_; |
854 | } |
855 | return $text; |
856 | } |
857 | |
858 | ##--------------------------------------------------------------------------- |
859 | |
860 | ## Private routines to set/unset child->parent links |
861 | |
862 | sub _unset_child2parent_links { |
863 | my $self = shift; |
864 | local *ptree = $self; |
865 | for (@ptree) { |
e9fdc7d2 |
866 | next unless (length and ref and $_->isa('Pod::InteriorSequence')); |
360aca43 |
867 | $_->_unset_child2parent_links(); |
868 | } |
869 | } |
870 | |
871 | sub _set_child2parent_links { |
872 | ## nothing to do, Pod::ParseTrees cant have parent pointers |
873 | } |
874 | |
875 | =head2 B<DESTROY()> |
876 | |
877 | This method performs any necessary cleanup for the parse-tree. |
878 | If you override this method then it is B<imperative> |
879 | that you invoke the parent method from within your own method, |
880 | otherwise I<parse-tree storage will not be reclaimed upon destruction!> |
881 | |
882 | =cut |
883 | |
884 | sub DESTROY { |
885 | ## We need to get rid of all child->parent pointers throughout the |
886 | ## tree so their reference counts will go to zero and they can be |
887 | ## garbage-collected |
888 | _unset_child2parent_links(@_); |
889 | } |
890 | |
891 | ############################################################################# |
892 | |
893 | =head1 SEE ALSO |
894 | |
895 | See L<Pod::Parser>, L<Pod::Select>, and L<Pod::Callbacks>. |
896 | |
897 | =head1 AUTHOR |
898 | |
899 | Brad Appleton E<lt>bradapp@enteract.comE<gt> |
900 | |
901 | =cut |
902 | |
903 | 1; |