← Index
NYTProf Performance Profile   « line view »
For /Users/timbo/perl5/perlbrew/perls/perl-5.18.2/bin/perlcritic
  Run on Sat Mar 19 22:12:22 2016
Reported on Sat Mar 19 22:14:10 2016

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