Commit | Line | Data |
---|---|---|
360aca43 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
313 | |
314 | ##--------------------------------------------------------------------------- | |
315 | ||
92e3d63a | 316 | =head2 $pod_para-E<gt>B<raw_text()> |
360aca43 GS |
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 GS |
328 | $_[0]->{'-separator'} . $_[0]->{'-text'}; |
329 | } | |
330 | ||
331 | ##--------------------------------------------------------------------------- | |
332 | ||
92e3d63a | 333 | =head2 $pod_para-E<gt>B<cmd_prefix()> |
360aca43 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
432 | my $pod_seq4 = new Pod::InteriorSequence(-name => $cmd, $ptree); |
433 | my $pod_seq5 = new Pod::InteriorSequence($cmd, $ptree); | |
434 | ||
360aca43 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
476 | @_ |
477 | }; | |
478 | ||
664bb207 GS |
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 GS |
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 GS |
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 GS |
521 | if (UNIVERSAL::isa($_, 'Pod::InteriorSequence') or |
522 | UNIVERSAL::can($_, 'nested')) | |
523 | { | |
360aca43 GS |
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 GS |
537 | $_->_unset_child2parent_links() |
538 | if UNIVERSAL::isa($_, 'Pod::InteriorSequence'); | |
360aca43 GS |
539 | } |
540 | } | |
541 | ||
542 | ##--------------------------------------------------------------------------- | |
543 | ||
92e3d63a | 544 | =head2 $pod_seq-E<gt>B<prepend()> |
360aca43 GS |
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 GS |
560 | |
561 | ##--------------------------------------------------------------------------- | |
562 | ||
92e3d63a | 563 | =head2 $pod_seq-E<gt>B<append()> |
360aca43 GS |
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 GS |
579 | |
580 | ##--------------------------------------------------------------------------- | |
581 | ||
92e3d63a | 582 | =head2 $pod_seq-E<gt>B<nested()> |
360aca43 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 MR |
855 | if (ref) { |
856 | push @ptree, $_; | |
857 | } | |
858 | elsif(!length) { | |
859 | next; | |
860 | } | |
861 | elsif ($can_append) { | |
360aca43 GS |
862 | $ptree[-1] .= $_; |
863 | } | |
864 | else { | |
865 | push @ptree, $_; | |
866 | } | |
867 | } | |
868 | } | |
869 | ||
92e3d63a | 870 | =head2 $ptree-E<gt>B<raw_text()> |
360aca43 GS |
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 GS |
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 GS |
897 | $_->_unset_child2parent_links() |
898 | if UNIVERSAL::isa($_, 'Pod::InteriorSequence'); | |
360aca43 GS |
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 GS |
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 GS |
927 | |
928 | =head1 AUTHOR | |
929 | ||
aaa799f9 NC |
930 | Please report bugs using L<http://rt.cpan.org>. |
931 | ||
360aca43 GS |
932 | Brad Appleton E<lt>bradapp@enteract.comE<gt> |
933 | ||
934 | =cut | |
935 | ||
936 | 1; |