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;
|
---|