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