← Index
NYTProf Performance Profile   « line view »
For webmerge/scripts/webmerge.pl
  Run on Mon Oct 7 02:42:42 2013
Reported on Mon Oct 7 03:03:27 2013

Filename/usr/lib64/perl5/vendor_perl/5.16.0/Pod/InputObjects.pm
StatementsExecuted 17 statements in 11.3ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11181µs182µsPod::InputObjects::::BEGIN@12 Pod::InputObjects::BEGIN@12
11164µs221µsPod::ParseTree::::BEGIN@822 Pod::ParseTree::BEGIN@822
11149µs211µsPod::InputObjects::::BEGIN@14 Pod::InputObjects::BEGIN@14
0000s0sPod::InputSource::::handle Pod::InputSource::handle
0000s0sPod::InputSource::::name Pod::InputSource::name
0000s0sPod::InputSource::::new Pod::InputSource::new
0000s0sPod::InputSource::::was_cutting Pod::InputSource::was_cutting
0000s0sPod::InteriorSequence::::DESTROYPod::InteriorSequence::DESTROY
0000s0sPod::InteriorSequence::::_set_child2parent_linksPod::InteriorSequence::_set_child2parent_links
0000s0sPod::InteriorSequence::::_unset_child2parent_linksPod::InteriorSequence::_unset_child2parent_links
0000s0sPod::InteriorSequence::::appendPod::InteriorSequence::append
0000s0sPod::InteriorSequence::::cmd_namePod::InteriorSequence::cmd_name
0000s0sPod::InteriorSequence::::file_linePod::InteriorSequence::file_line
0000s0sPod::InteriorSequence::::left_delimiterPod::InteriorSequence::left_delimiter
0000s0sPod::InteriorSequence::::nestedPod::InteriorSequence::nested
0000s0sPod::InteriorSequence::::newPod::InteriorSequence::new
0000s0sPod::InteriorSequence::::parse_treePod::InteriorSequence::parse_tree
0000s0sPod::InteriorSequence::::prependPod::InteriorSequence::prepend
0000s0sPod::InteriorSequence::::raw_textPod::InteriorSequence::raw_text
0000s0sPod::InteriorSequence::::right_delimiterPod::InteriorSequence::right_delimiter
0000s0sPod::Paragraph::::cmd_name Pod::Paragraph::cmd_name
0000s0sPod::Paragraph::::cmd_prefix Pod::Paragraph::cmd_prefix
0000s0sPod::Paragraph::::cmd_separator Pod::Paragraph::cmd_separator
0000s0sPod::Paragraph::::file_line Pod::Paragraph::file_line
0000s0sPod::Paragraph::::new Pod::Paragraph::new
0000s0sPod::Paragraph::::parse_tree Pod::Paragraph::parse_tree
0000s0sPod::Paragraph::::raw_text Pod::Paragraph::raw_text
0000s0sPod::Paragraph::::text Pod::Paragraph::text
0000s0sPod::ParseTree::::DESTROY Pod::ParseTree::DESTROY
0000s0sPod::ParseTree::::_set_child2parent_links Pod::ParseTree::_set_child2parent_links
0000s0sPod::ParseTree::::_unset_child2parent_links Pod::ParseTree::_unset_child2parent_links
0000s0sPod::ParseTree::::append Pod::ParseTree::append
0000s0sPod::ParseTree::::children Pod::ParseTree::children
0000s0sPod::ParseTree::::new Pod::ParseTree::new
0000s0sPod::ParseTree::::prepend Pod::ParseTree::prepend
0000s0sPod::ParseTree::::raw_text Pod::ParseTree::raw_text
0000s0sPod::ParseTree::::top Pod::ParseTree::top
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
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
11package Pod::InputObjects;
122167µs2282µs
# spent 182µs (81+100) within Pod::InputObjects::BEGIN@12 which was called: # once (81µs+100µs) by Pod::Parser::BEGIN@205 at line 12
use strict;
# spent 182µs making 1 call to Pod::InputObjects::BEGIN@12 # spent 100µs making 1 call to strict::import
13
1428.95ms2373µs
# spent 211µs (49+162) within Pod::InputObjects::BEGIN@14 which was called: # once (49µs+162µs) by Pod::Parser::BEGIN@205 at line 14
use vars qw($VERSION);
# spent 211µs making 1 call to Pod::InputObjects::BEGIN@14 # spent 162µs making 1 call to vars::import
1514µs$VERSION = '1.31'; ## Current version of this package
16160µsrequire 5.005; ## requires this Perl version or later
17
18#############################################################################
19
20=head1 NAME
21
22Pod::InputObjects - objects representing POD input paragraphs, commands, etc.
23
24=head1 SYNOPSIS
25
26 use Pod::InputObjects;
27
28=head1 REQUIRES
29
30perl5.004, Carp
31
32=head1 EXPORTS
33
34Nothing.
35
36=head1 DESCRIPTION
37
38This module defines some basic input objects used by B<Pod::Parser> when
39reading and parsing POD text from an input source. The following objects
40are defined:
41
42=over 4
43
44=begin __PRIVATE__
45
46=item package B<Pod::InputSource>
47
48An object corresponding to a source of POD input text. It is mostly a
49wrapper around a filehandle or C<IO::Handle>-type object (or anything
50that implements the C<getline()> method) which keeps track of some
51additional information relevant to the parsing of PODs.
52
53=end __PRIVATE__
54
55=item package B<Pod::Paragraph>
56
57An object corresponding to a paragraph of POD input text. It may be a
58plain paragraph, a verbatim paragraph, or a command paragraph (see
59L<perlpod>).
60
61=item package B<Pod::InteriorSequence>
62
63An object corresponding to an interior sequence command from the POD
64input text (see L<perlpod>).
65
66=item package B<Pod::ParseTree>
67
68An object corresponding to a tree of parsed POD text. Each "node" in
69a parse-tree (or I<ptree>) is either a text-string or a reference to
70a B<Pod::InteriorSequence> object. The nodes appear in the parse-tree
71in the order in which they were parsed from left-to-right.
72
73=back
74
75Each of these input objects are described in further detail in the
76sections which follow.
77
78=cut
79
80#############################################################################
81
82package Pod::InputSource;
83
84##---------------------------------------------------------------------------
85
86=begin __PRIVATE__
87
88=head1 B<Pod::InputSource>
89
90This object corresponds to an input source or stream of POD
91documentation. When parsing PODs, it is necessary to associate and store
92certain context information with each input source. All of this
93information is kept together with the stream itself in one of these
94C<Pod::InputSource> objects. Each such object is merely a wrapper around
95an C<IO::Handle> object of some kind (or at least something that
96implements the C<getline()> method). They have the following
97methods/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
116This is a class method that constructs a C<Pod::InputSource> object and
117returns a reference to the new input source object. It takes one or more
118keyword arguments in the form of a hash. The keyword C<-handle> is
119required and designates the corresponding input handle. The keyword
120C<-name> is optional and specifies the name associated with the input
121handle (typically a file name).
122
123=end __PRIVATE__
124
125=cut
126
127sub 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
155This method gets/sets the name of the input source (usually a filename).
156If no argument is given, it returns a string containing the name of
157the input source; otherwise it sets the name of the input source to the
158contents of the given argument.
159
160=end __PRIVATE__
161
162=cut
163
164sub name {
165 (@_ > 1) and $_[0]->{'-name'} = $_[1];
166 return $_[0]->{'-name'};
167}
168
169## allow 'filename' as an alias for 'name'
170110µs*filename = \&name;
171
172##---------------------------------------------------------------------------
173
174=begin __PRIVATE__
175
176=head2 B<handle()>
177
178 my $handle = $pod_input->handle();
179
180Returns a reference to the handle object from which input is read (the
181one used to contructed this input source object).
182
183=end __PRIVATE__
184
185=cut
186
187sub 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
199The value of the C<cutting> state (that the B<cutting()> method would
200have returned) immediately before any input was read from this input
201stream. After all input from this stream has been read, the C<cutting>
202state is restored to this value.
203
204=end __PRIVATE__
205
206=cut
207
208sub was_cutting {
209 (@_ > 1) and $_[0]->{-was_cutting} = $_[1];
210 return $_[0]->{-was_cutting};
211}
212
213##---------------------------------------------------------------------------
214
215#############################################################################
216
217package Pod::Paragraph;
218
219##---------------------------------------------------------------------------
220
221=head1 B<Pod::Paragraph>
222
223An object representing a paragraph of POD input text.
224It has the following methods/attributes:
225
226=cut
227
228##---------------------------------------------------------------------------
229
230=head2 Pod::Paragraph-E<gt>B<new()>
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
243This is a class method that constructs a C<Pod::Paragraph> object and
244returns a reference to the new paragraph object. It may be given one or
245two keyword arguments. The C<-text> keyword indicates the corresponding
246text of the POD paragraph. The C<-name> keyword indicates the name of
247the corresponding POD command, such as C<head1> or C<item> (it should
248I<not> contain the C<=> prefix); this is needed only if the POD
249paragraph corresponds to a command paragraph. The C<-file> and C<-line>
250keywords indicate the filename and line number corresponding to the
251beginning of the paragraph
252
253=cut
254
255sub 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,
266 -text => (@_ == 1) ? shift : undef,
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
282=head2 $pod_para-E<gt>B<cmd_name()>
283
284 my $para_cmd = $pod_para->cmd_name();
285
286If this paragraph is a command paragraph, then this method will return
287the name of the command (I<without> any leading C<=> prefix).
288
289=cut
290
291sub cmd_name {
292 (@_ > 1) and $_[0]->{'-name'} = $_[1];
293 return $_[0]->{'-name'};
294}
295
296## let name() be an alias for cmd_name()
29714µs*name = \&cmd_name;
298
299##---------------------------------------------------------------------------
300
301=head2 $pod_para-E<gt>B<text()>
302
303 my $para_text = $pod_para->text();
304
305This method will return the corresponding text of the paragraph.
306
307=cut
308
309sub text {
310 (@_ > 1) and $_[0]->{'-text'} = $_[1];
311 return $_[0]->{'-text'};
312}
313
314##---------------------------------------------------------------------------
315
316=head2 $pod_para-E<gt>B<raw_text()>
317
318 my $raw_pod_para = $pod_para->raw_text();
319
320This method will return the I<raw> text of the POD paragraph, exactly
321as it appeared in the input.
322
323=cut
324
325sub raw_text {
326 return $_[0]->{'-text'} unless (defined $_[0]->{'-name'});
327 return $_[0]->{'-prefix'} . $_[0]->{'-name'} .
328 $_[0]->{'-separator'} . $_[0]->{'-text'};
329}
330
331##---------------------------------------------------------------------------
332
333=head2 $pod_para-E<gt>B<cmd_prefix()>
334
335 my $prefix = $pod_para->cmd_prefix();
336
337If this paragraph is a command paragraph, then this method will return
338the prefix used to denote the command (which should be the string "="
339or "==").
340
341=cut
342
343sub cmd_prefix {
344 return $_[0]->{'-prefix'};
345}
346
347##---------------------------------------------------------------------------
348
349=head2 $pod_para-E<gt>B<cmd_separator()>
350
351 my $separator = $pod_para->cmd_separator();
352
353If this paragraph is a command paragraph, then this method will return
354the text used to separate the command name from the rest of the
355paragraph (if any).
356
357=cut
358
359sub cmd_separator {
360 return $_[0]->{'-separator'};
361}
362
363##---------------------------------------------------------------------------
364
365=head2 $pod_para-E<gt>B<parse_tree()>
366
367 my $ptree = $pod_parser->parse_text( $pod_para->text() );
368 $pod_para->parse_tree( $ptree );
369 $ptree = $pod_para->parse_tree();
370
371This method will get/set the corresponding parse-tree of the paragraph's text.
372
373=cut
374
375sub parse_tree {
376 (@_ > 1) and $_[0]->{'-ptree'} = $_[1];
377 return $_[0]->{'-ptree'};
378}
379
380## let ptree() be an alias for parse_tree()
38113µs*ptree = \&parse_tree;
382
383##---------------------------------------------------------------------------
384
385=head2 $pod_para-E<gt>B<file_line()>
386
387 my ($filename, $line_number) = $pod_para->file_line();
388 my $position = $pod_para->file_line();
389
390Returns the current filename and line number for the paragraph
391object. If called in a list context, it returns a list of two
392elements: first the filename, then the line number. If called in
393a scalar context, it returns a string containing the filename, followed
394by a colon (':'), followed by the line number.
395
396=cut
397
398sub 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
408package Pod::InteriorSequence;
409
410##---------------------------------------------------------------------------
411
412=head1 B<Pod::InteriorSequence>
413
414An object representing a POD interior sequence command.
415It has the following methods/attributes:
416
417=cut
418
419##---------------------------------------------------------------------------
420
421=head2 Pod::InteriorSequence-E<gt>B<new()>
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
432 my $pod_seq4 = new Pod::InteriorSequence(-name => $cmd, $ptree);
433 my $pod_seq5 = new Pod::InteriorSequence($cmd, $ptree);
434
435This is a class method that constructs a C<Pod::InteriorSequence> object
436and returns a reference to the new interior sequence object. It should
437be given two keyword arguments. The C<-ldelim> keyword indicates the
438corresponding left-delimiter of the interior sequence (e.g. 'E<lt>').
439The C<-name> keyword indicates the name of the corresponding interior
440sequence command, such as C<I> or C<B> or C<C>. The C<-file> and
441C<-line> keywords indicate the filename and line number corresponding
442to the beginning of the interior sequence. If the C<$ptree> argument is
443given, it must be the last argument, and it must be either string, or
444else an array-ref suitable for passing to B<Pod::ParseTree::new> (or
445it may be a reference to a Pod::ParseTree object).
446
447=cut
448
449sub 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
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
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 => '>',
476 @_
477 };
478
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
488 ## Bless ourselves into the desired class and perform any initialization
489 bless $self, $class;
490 return $self;
491}
492
493##---------------------------------------------------------------------------
494
495=head2 $pod_seq-E<gt>B<cmd_name()>
496
497 my $seq_cmd = $pod_seq->cmd_name();
498
499The name of the interior sequence command.
500
501=cut
502
503sub cmd_name {
504 (@_ > 1) and $_[0]->{'-name'} = $_[1];
505 return $_[0]->{'-name'};
506}
507
508## let name() be an alias for cmd_name()
50913µs*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
516sub _set_child2parent_links {
517 my ($self, @children) = @_;
518 ## Make sure any sequences know who their parent is
519 for (@children) {
520 next unless (length and ref and ref ne 'SCALAR');
521 if (UNIVERSAL::isa($_, 'Pod::InteriorSequence') or
522 UNIVERSAL::can($_, 'nested'))
523 {
524 $_->nested($self);
525 }
526 }
527}
528
529## Private subroutine to unset child->parent links
530
531sub _unset_child2parent_links {
532 my $self = shift;
533 $self->{'-parent_sequence'} = undef;
534 my $ptree = $self->{'-ptree'};
535 for (@$ptree) {
536 next unless (length and ref and ref ne 'SCALAR');
537 $_->_unset_child2parent_links()
538 if UNIVERSAL::isa($_, 'Pod::InteriorSequence');
539 }
540}
541
542##---------------------------------------------------------------------------
543
544=head2 $pod_seq-E<gt>B<prepend()>
545
546 $pod_seq->prepend($text);
547 $pod_seq1->prepend($pod_seq2);
548
549Prepends the given string or parse-tree or sequence object to the parse-tree
550of this interior sequence.
551
552=cut
553
554sub prepend {
555 my $self = shift;
556 $self->{'-ptree'}->prepend(@_);
557 _set_child2parent_links($self, @_);
558 return $self;
559}
560
561##---------------------------------------------------------------------------
562
563=head2 $pod_seq-E<gt>B<append()>
564
565 $pod_seq->append($text);
566 $pod_seq1->append($pod_seq2);
567
568Appends the given string or parse-tree or sequence object to the parse-tree
569of this interior sequence.
570
571=cut
572
573sub append {
574 my $self = shift;
575 $self->{'-ptree'}->append(@_);
576 _set_child2parent_links($self, @_);
577 return $self;
578}
579
580##---------------------------------------------------------------------------
581
582=head2 $pod_seq-E<gt>B<nested()>
583
584 $outer_seq = $pod_seq->nested || print "not nested";
585
586If this interior sequence is nested inside of another interior
587sequence, then the outer/parent sequence that contains it is
588returned. Otherwise C<undef> is returned.
589
590=cut
591
592sub nested {
593 my $self = shift;
594 (@_ == 1) and $self->{'-parent_sequence'} = shift;
595 return $self->{'-parent_sequence'} || undef;
596}
597
598##---------------------------------------------------------------------------
599
600=head2 $pod_seq-E<gt>B<raw_text()>
601
602 my $seq_raw_text = $pod_seq->raw_text();
603
604This method will return the I<raw> text of the POD interior sequence,
605exactly as it appeared in the input.
606
607=cut
608
609sub 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
621=head2 $pod_seq-E<gt>B<left_delimiter()>
622
623 my $ldelim = $pod_seq->left_delimiter();
624
625The leftmost delimiter beginning the argument text to the interior
626sequence (should be "<").
627
628=cut
629
630sub left_delimiter {
631 (@_ > 1) and $_[0]->{'-ldelim'} = $_[1];
632 return $_[0]->{'-ldelim'};
633}
634
635## let ldelim() be an alias for left_delimiter()
63612µs*ldelim = \&left_delimiter;
637
638##---------------------------------------------------------------------------
639
640=head2 $pod_seq-E<gt>B<right_delimiter()>
641
642The rightmost delimiter beginning the argument text to the interior
643sequence (should be ">").
644
645=cut
646
647sub right_delimiter {
648 (@_ > 1) and $_[0]->{'-rdelim'} = $_[1];
649 return $_[0]->{'-rdelim'};
650}
651
652## let rdelim() be an alias for right_delimiter()
65312µs*rdelim = \&right_delimiter;
654
655##---------------------------------------------------------------------------
656
657=head2 $pod_seq-E<gt>B<parse_tree()>
658
659 my $ptree = $pod_parser->parse_text($paragraph_text);
660 $pod_seq->parse_tree( $ptree );
661 $ptree = $pod_seq->parse_tree();
662
663This method will get/set the corresponding parse-tree of the interior
664sequence's text.
665
666=cut
667
668sub parse_tree {
669 (@_ > 1) and $_[0]->{'-ptree'} = $_[1];
670 return $_[0]->{'-ptree'};
671}
672
673## let ptree() be an alias for parse_tree()
67412µs*ptree = \&parse_tree;
675
676##---------------------------------------------------------------------------
677
678=head2 $pod_seq-E<gt>B<file_line()>
679
680 my ($filename, $line_number) = $pod_seq->file_line();
681 my $position = $pod_seq->file_line();
682
683Returns the current filename and line number for the interior sequence
684object. If called in a list context, it returns a list of two
685elements: first the filename, then the line number. If called in
686a scalar context, it returns a string containing the filename, followed
687by a colon (':'), followed by the line number.
688
689=cut
690
691sub file_line {
692 my @loc = ($_[0]->{'-file'} || '<unknown-file>',
693 $_[0]->{'-line'} || 0);
694 return (wantarray) ? @loc : join(':', @loc);
695}
696
697##---------------------------------------------------------------------------
698
699=head2 Pod::InteriorSequence::B<DESTROY()>
700
701This method performs any necessary cleanup for the interior-sequence.
702If you override this method then it is B<imperative> that you invoke
703the parent method from within your own method, otherwise
704I<interior-sequence storage will not be reclaimed upon destruction!>
705
706=cut
707
708sub 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
719package Pod::ParseTree;
720
721##---------------------------------------------------------------------------
722
723=head1 B<Pod::ParseTree>
724
725This object corresponds to a tree of parsed POD text. As POD text is
726scanned from left to right, it is parsed into an ordered list of
727text-strings and B<Pod::InteriorSequence> objects (in order of
728appearance). A B<Pod::ParseTree> object corresponds to this list of
729strings and sequences. Each interior sequence in the parse-tree may
730itself contain a parse-tree (since interior sequences may be nested).
731
732=cut
733
734##---------------------------------------------------------------------------
735
736=head2 Pod::ParseTree-E<gt>B<new()>
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
743This is a class method that constructs a C<Pod::Parse_tree> object and
744returns a reference to the new parse-tree. If a single-argument is given,
745it must be a reference to an array, and is used to initialize the root
746(top) of the parse tree.
747
748=cut
749
750sub 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
764=head2 $ptree-E<gt>B<top()>
765
766 my $top_node = $ptree->top();
767 $ptree->top( $top_node );
768 $ptree->top( @children );
769
770This method gets/sets the top node of the parse-tree. If no arguments are
771given, it returns the topmost node in the tree (the root), which is also
772a B<Pod::ParseTree>. If it is given a single argument that is a reference,
773then the reference is assumed to a parse-tree and becomes the new top node.
774Otherwise, if arguments are given, they are treated as the new list of
775children for the top node.
776
777=cut
778
779sub 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
78818µs*parse_tree = *ptree = \&top;
789
790##---------------------------------------------------------------------------
791
792=head2 $ptree-E<gt>B<children()>
793
794This method gets/sets the children of the top node in the parse-tree.
795If 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>.
797Otherwise, if arguments are given, they are treated as the new list of
798children for the top node.
799
800=cut
801
802sub children {
803 my $self = shift;
804 if (@_ > 0) {
805 @{ $self } = (@_ == 1 and ref $_[0]) ? ${ @_ } : @_;
806 }
807 return @{ $self };
808}
809
810##---------------------------------------------------------------------------
811
812=head2 $ptree-E<gt>B<prepend()>
813
814This method prepends the given text or parse-tree to the current parse-tree.
815If the first item on the parse-tree is text and the argument is also text,
816then the text is prepended to the first item (not added as a separate string).
817Otherwise the argument is added as a new string or parse-tree I<before>
818the current one.
819
820=cut
821
82222.06ms2377µs
# spent 221µs (64+156) within Pod::ParseTree::BEGIN@822 which was called: # once (64µs+156µs) by Pod::Parser::BEGIN@205 at line 822
use vars qw(@ptree); ## an alias used for performance reasons
# spent 221µs making 1 call to Pod::ParseTree::BEGIN@822 # spent 156µs making 1 call to vars::import
823
824sub prepend {
825 my $self = shift;
826 local *ptree = $self;
827 for (@_) {
828 next unless length;
829 if (@ptree && !(ref $ptree[0]) && !(ref $_)) {
830 $ptree[0] = $_ . $ptree[0];
831 }
832 else {
833 unshift @ptree, $_;
834 }
835 }
836}
837
838##---------------------------------------------------------------------------
839
840=head2 $ptree-E<gt>B<append()>
841
842This method appends the given text or parse-tree to the current parse-tree.
843If the last item on the parse-tree is text and the argument is also text,
844then the text is appended to the last item (not added as a separate string).
845Otherwise the argument is added as a new string or parse-tree I<after>
846the current one.
847
848=cut
849
850sub append {
851 my $self = shift;
852 local *ptree = $self;
853 my $can_append = @ptree && !(ref $ptree[-1]);
854 for (@_) {
855 if (ref) {
856 push @ptree, $_;
857 }
858 elsif(!length) {
859 next;
860 }
861 elsif ($can_append) {
862 $ptree[-1] .= $_;
863 }
864 else {
865 push @ptree, $_;
866 }
867 }
868}
869
870=head2 $ptree-E<gt>B<raw_text()>
871
872 my $ptree_raw_text = $ptree->raw_text();
873
874This method will return the I<raw> text of the POD parse-tree
875exactly as it appeared in the input.
876
877=cut
878
879sub raw_text {
880 my $self = shift;
881 my $text = '';
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
892sub _unset_child2parent_links {
893 my $self = shift;
894 local *ptree = $self;
895 for (@ptree) {
896 next unless (defined and length and ref and ref ne 'SCALAR');
897 $_->_unset_child2parent_links()
898 if UNIVERSAL::isa($_, 'Pod::InteriorSequence');
899 }
900}
901
902sub _set_child2parent_links {
903 ## nothing to do, Pod::ParseTrees cant have parent pointers
904}
905
906=head2 Pod::ParseTree::B<DESTROY()>
907
908This method performs any necessary cleanup for the parse-tree.
909If you override this method then it is B<imperative>
910that you invoke the parent method from within your own method,
911otherwise I<parse-tree storage will not be reclaimed upon destruction!>
912
913=cut
914
915sub 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
926See L<Pod::Parser>, L<Pod::Select>
927
928=head1 AUTHOR
929
930Please report bugs using L<http://rt.cpan.org>.
931
932Brad Appleton E<lt>bradapp@enteract.comE<gt>
933
934=cut
935
936137µs1;
Report produced by the NYTProf 5.05 Perl profiler, developed by Tim Bunce and Adam Kaplan.