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