← 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:12 2016

Filename/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/PPI/Document.pm
StatementsExecuted 2278433 statements in 3.07s
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
94225111.08s2.00sPPI::Document::::_add_locationPPI::Document::_add_location
14411636ms3.24sPPI::Document::::index_locationsPPI::Document::index_locations
14411576ms1.23sPPI::Document::::serializePPI::Document::serialize
7976321466ms587msPPI::Document::::_visual_lengthPPI::Document::_visual_length
9422511256ms286msPPI::Document::::_logical_line_and_filePPI::Document::_logical_line_and_file
797631195.9ms95.9msPPI::Document::::tab_widthPPI::Document::tab_width
1915497180.1ms80.1msPPI::Document::::CORE:matchPPI::Document::CORE:match (opcode)
288226.81ms13.2sPPI::Document::::newPPI::Document::new (recurses: max depth 1, inclusive time 3.10ms)
14411667µs667µsPPI::Document::::_setattrPPI::Document::_setattr
111189µs259µsPPI::Document::::BEGIN@86PPI::Document::BEGIN@86
111142µs211µsPPI::Document::::BEGIN@74PPI::Document::BEGIN@74
11112µs24µsPPI::Document::::BEGIN@66PPI::Document::BEGIN@66
1118µs33µsPPI::Document::::BEGIN@76PPI::Document::BEGIN@76
1118µs57µsPPI::Document::::BEGIN@92PPI::Document::BEGIN@92
1118µs8µsPPI::Document::::BEGIN@80PPI::Document::BEGIN@80
1117µs39µsPPI::Document::::BEGIN@69PPI::Document::BEGIN@69
1116µs22µsPPI::Document::::BEGIN@77PPI::Document::BEGIN@77
1116µs45µsPPI::Document::::BEGIN@79PPI::Document::BEGIN@79
1116µs37µsPPI::Document::::BEGIN@93PPI::Document::BEGIN@93
1116µs37µsPPI::Document::::BEGIN@96PPI::Document::BEGIN@96
1116µs36µsPPI::Document::::BEGIN@94PPI::Document::BEGIN@94
1116µs35µsPPI::Document::::BEGIN@95PPI::Document::BEGIN@95
1113µs3µsPPI::Document::::BEGIN@70PPI::Document::BEGIN@70
1113µs3µsPPI::Document::::BEGIN@67PPI::Document::BEGIN@67
1113µs3µsPPI::Document::::BEGIN@68PPI::Document::BEGIN@68
1113µs3µsPPI::Document::::BEGIN@71PPI::Document::BEGIN@71
1113µs3µsPPI::Document::::BEGIN@72PPI::Document::BEGIN@72
1113µs3µsPPI::Document::::BEGIN@73PPI::Document::BEGIN@73
0000s0sPPI::Document::::STORABLE_freezePPI::Document::STORABLE_freeze
0000s0sPPI::Document::::STORABLE_thawPPI::Document::STORABLE_thaw
0000s0sPPI::Document::::__ANON__[:192]PPI::Document::__ANON__[:192]
0000s0sPPI::Document::::__ANON__[:208]PPI::Document::__ANON__[:208]
0000s0sPPI::Document::::__ANON__[:223]PPI::Document::__ANON__[:223]
0000s0sPPI::Document::::__ANON__[:238]PPI::Document::__ANON__[:238]
0000s0sPPI::Document::::__ANON__[:490]PPI::Document::__ANON__[:490]
0000s0sPPI::Document::::__ANON__[:505]PPI::Document::__ANON__[:505]
0000s0sPPI::Document::::__ANON__[:820]PPI::Document::__ANON__[:820]
0000s0sPPI::Document::::_clearPPI::Document::_clear
0000s0sPPI::Document::::_errorPPI::Document::_error
0000s0sPPI::Document::::completePPI::Document::complete
0000s0sPPI::Document::::errstrPPI::Document::errstr
0000s0sPPI::Document::::flush_locationsPPI::Document::flush_locations
0000s0sPPI::Document::::get_cachePPI::Document::get_cache
0000s0sPPI::Document::::hex_idPPI::Document::hex_id
0000s0sPPI::Document::::insert_afterPPI::Document::insert_after
0000s0sPPI::Document::::insert_beforePPI::Document::insert_before
0000s0sPPI::Document::::loadPPI::Document::load
0000s0sPPI::Document::::normalizedPPI::Document::normalized
0000s0sPPI::Document::::readonlyPPI::Document::readonly
0000s0sPPI::Document::::replacePPI::Document::replace
0000s0sPPI::Document::::savePPI::Document::save
0000s0sPPI::Document::::scopePPI::Document::scope
0000s0sPPI::Document::::set_cachePPI::Document::set_cache
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package PPI::Document;
2
3=pod
4
5=head1 NAME
6
7PPI::Document - Object representation of a Perl document
8
9=head1 INHERITANCE
10
11 PPI::Document
12 isa PPI::Node
13 isa PPI::Element
14
15=head1 SYNOPSIS
16
17 use PPI;
18
19 # Load a document from a file
20 my $Document = PPI::Document->new('My/Module.pm');
21
22 # Strip out comments
23 $Document->prune('PPI::Token::Comment');
24
25 # Find all the named subroutines
26 my $sub_nodes = $Document->find(
27 sub { $_[1]->isa('PPI::Statement::Sub') and $_[1]->name }
28 );
29 my @sub_names = map { $_->name } @$sub_nodes;
30
31 # Save the file
32 $Document->save('My/Module.pm.stripped');
33
34=head1 DESCRIPTION
35
36The C<PPI::Document> class represents a single Perl "document". A
37C<PPI::Document> object acts as a root L<PPI::Node>, with some
38additional methods for loading and saving, and working with
39the line/column locations of Elements within a file.
40
41The exemption to its L<PPI::Node>-like behavior this is that a
42C<PPI::Document> object can NEVER have a parent node, and is always
43the root node in a tree.
44
45=head2 Storable Support
46
47C<PPI::Document> implements the necessary C<STORABLE_freeze> and
48C<STORABLE_thaw> hooks to provide native support for L<Storable>,
49if you have it installed.
50
51However if you want to clone clone a Document, you are highly recommended
52to use the internal C<$Document-E<gt>clone> method rather than Storable's
53C<dclone> function (although C<dclone> should still work).
54
55=head1 METHODS
56
57Most of the things you are likely to want to do with a Document are
58probably going to involve the methods from L<PPI::Node> class, of which
59this is a subclass.
60
61The methods listed here are the remaining few methods that are truly
62Document-specific.
63
64=cut
65
66219µs236µs
# spent 24µs (12+12) within PPI::Document::BEGIN@66 which was called: # once (12µs+12µs) by PPI::BEGIN@23 at line 66
use strict;
# spent 24µs making 1 call to PPI::Document::BEGIN@66 # spent 12µs making 1 call to strict::import
67216µs13µs
# spent 3µs within PPI::Document::BEGIN@67 which was called: # once (3µs+0s) by PPI::BEGIN@23 at line 67
use Carp ();
# spent 3µs making 1 call to PPI::Document::BEGIN@67
68222µs13µs
# spent 3µs within PPI::Document::BEGIN@68 which was called: # once (3µs+0s) by PPI::BEGIN@23 at line 68
use List::MoreUtils ();
# spent 3µs making 1 call to PPI::Document::BEGIN@68
69219µs271µs
# spent 39µs (7+32) within PPI::Document::BEGIN@69 which was called: # once (7µs+32µs) by PPI::BEGIN@23 at line 69
use Params::Util qw{_SCALAR0 _ARRAY0 _INSTANCE};
# spent 39µs making 1 call to PPI::Document::BEGIN@69 # spent 32µs making 1 call to Exporter::import
70215µs13µs
# spent 3µs within PPI::Document::BEGIN@70 which was called: # once (3µs+0s) by PPI::BEGIN@23 at line 70
use Digest::MD5 ();
# spent 3µs making 1 call to PPI::Document::BEGIN@70
71214µs13µs
# spent 3µs within PPI::Document::BEGIN@71 which was called: # once (3µs+0s) by PPI::BEGIN@23 at line 71
use PPI::Util ();
# spent 3µs making 1 call to PPI::Document::BEGIN@71
72214µs13µs
# spent 3µs within PPI::Document::BEGIN@72 which was called: # once (3µs+0s) by PPI::BEGIN@23 at line 72
use PPI ();
# spent 3µs making 1 call to PPI::Document::BEGIN@72
73214µs13µs
# spent 3µs within PPI::Document::BEGIN@73 which was called: # once (3µs+0s) by PPI::BEGIN@23 at line 73
use PPI::Node ();
# spent 3µs making 1 call to PPI::Document::BEGIN@73
74288µs1211µs
# spent 211µs (142+69) within PPI::Document::BEGIN@74 which was called: # once (142µs+69µs) by PPI::BEGIN@23 at line 74
use PPI::Exception::ParserTimeout ();
# spent 211µs making 1 call to PPI::Document::BEGIN@74
75
76223µs258µs
# spent 33µs (8+25) within PPI::Document::BEGIN@76 which was called: # once (8µs+25µs) by PPI::BEGIN@23 at line 76
use overload 'bool' => \&PPI::Util::TRUE;
# spent 33µs making 1 call to PPI::Document::BEGIN@76 # spent 25µs making 1 call to overload::import
77220µs237µs
# spent 22µs (6+15) within PPI::Document::BEGIN@77 which was called: # once (6µs+15µs) by PPI::BEGIN@23 at line 77
use overload '""' => 'content';
# spent 22µs making 1 call to PPI::Document::BEGIN@77 # spent 15µs making 1 call to overload::import
78
79231µs284µs
# spent 45µs (6+39) within PPI::Document::BEGIN@79 which was called: # once (6µs+39µs) by PPI::BEGIN@23 at line 79
use vars qw{$VERSION @ISA $errstr};
# spent 45µs making 1 call to PPI::Document::BEGIN@79 # spent 39µs making 1 call to vars::import
80
# spent 8µs within PPI::Document::BEGIN@80 which was called: # once (8µs+0s) by PPI::BEGIN@23 at line 84
BEGIN {
811300ns $VERSION = '1.215';
8215µs @ISA = 'PPI::Node';
8314µs $errstr = '';
84114µs18µs}
# spent 8µs making 1 call to PPI::Document::BEGIN@80
85
86292µs1259µs
# spent 259µs (189+70) within PPI::Document::BEGIN@86 which was called: # once (189µs+70µs) by PPI::BEGIN@23 at line 86
use PPI::Document::Fragment ();
# spent 259µs making 1 call to PPI::Document::BEGIN@86
87
88# Document cache
891400nsmy $CACHE = undef;
90
91# Convenience constants related to constants
92223µs2107µs
# spent 57µs (8+49) within PPI::Document::BEGIN@92 which was called: # once (8µs+49µs) by PPI::BEGIN@23 at line 92
use constant LOCATION_LINE => 0;
# spent 57µs making 1 call to PPI::Document::BEGIN@92 # spent 49µs making 1 call to constant::import
93220µs268µs
# spent 37µs (6+31) within PPI::Document::BEGIN@93 which was called: # once (6µs+31µs) by PPI::BEGIN@23 at line 93
use constant LOCATION_CHARACTER => 1;
# spent 37µs making 1 call to PPI::Document::BEGIN@93 # spent 31µs making 1 call to constant::import
94219µs266µs
# spent 36µs (6+30) within PPI::Document::BEGIN@94 which was called: # once (6µs+30µs) by PPI::BEGIN@23 at line 94
use constant LOCATION_COLUMN => 2;
# spent 36µs making 1 call to PPI::Document::BEGIN@94 # spent 30µs making 1 call to constant::import
95223µs265µs
# spent 35µs (6+30) within PPI::Document::BEGIN@95 which was called: # once (6µs+30µs) by PPI::BEGIN@23 at line 95
use constant LOCATION_LOGICAL_LINE => 3;
# spent 35µs making 1 call to PPI::Document::BEGIN@95 # spent 30µs making 1 call to constant::import
9622.17ms268µs
# spent 37µs (6+31) within PPI::Document::BEGIN@96 which was called: # once (6µs+31µs) by PPI::BEGIN@23 at line 96
use constant LOCATION_LOGICAL_FILE => 4;
# spent 37µs making 1 call to PPI::Document::BEGIN@96 # spent 31µs making 1 call to constant::import
97
- -
102#####################################################################
103# Constructor and Static Methods
104
105=pod
106
107=head2 new
108
109 # Simple construction
110 $doc = PPI::Document->new( $filename );
111 $doc = PPI::Document->new( \$source );
112
113 # With the readonly attribute set
114 $doc = PPI::Document->new( $filename,
115 readonly => 1,
116 );
117
118The C<new> constructor takes as argument a variety of different sources of
119Perl code, and creates a single cohesive Perl C<PPI::Document>
120for it.
121
122If passed a file name as a normal string, it will attempt to load the
123document from the file.
124
125If passed a reference to a C<SCALAR>, this is taken to be source code and
126parsed directly to create the document.
127
128If passed zero arguments, a "blank" document will be created that contains
129no content at all.
130
131In all cases, the document is considered to be "anonymous" and not tied back
132to where it was created from. Specifically, if you create a PPI::Document from
133a filename, the document will B<not> remember where it was created from.
134
135The constructor also takes attribute flags.
136
137At this time, the only available attribute is the C<readonly> flag.
138
139Setting C<readonly> to true will allow various systems to provide
140additional optimisations and caching. Note that because C<readonly> is an
141optimisation flag, it is off by default and you will need to explicitly
142enable it.
143
144Returns a C<PPI::Document> object, or C<undef> if parsing fails.
145
146=cut
147
148
# spent 13.2s (6.81ms+13.2) within PPI::Document::new which was called 288 times, avg 46.0ms/call: # 144 times (4.55ms+13.2s) by PPI::Document::File::new at line 62 of PPI/Document/File.pm, avg 92.0ms/call # 144 times (2.26ms+-2.26ms) by PPI::Lexer::lex_tokenizer at line 221 of PPI/Lexer.pm, avg 0s/call
sub new {
14928894µs local $_; # An extra one, just in case
150288236µs my $class = ref $_[0] ? ref shift : shift;
151
152288235µs unless ( @_ ) {
153144558µs144842µs my $self = $class->SUPER::new;
# spent 842µs making 144 calls to PPI::Node::new, avg 6µs/call
154144514µs $self->{readonly} = ! 1;
155144100µs $self->{tab_width} = 1;
156144644µs return $self;
157 }
158
159 # Check constructor attributes
16014447µs my $source = shift;
16114493µs my %attr = @_;
162144106µs my $timeout = delete $attr{timeout};
16314445µs if ( $timeout and ! PPI::Util::HAVE_ALARM() ) {
164 Carp::croak("This platform does not support PPI parser timeouts");
165 }
166
167 # Check the data source
168144119µs if ( ! defined $source ) {
169 $class->_error("An undefined value was passed to PPI::Document::new");
170
171 } elsif ( ! ref $source ) {
172 # Catch people using the old API
173144965µs144506µs if ( $source =~ /(?:\012|\015)/ ) {
# spent 506µs making 144 calls to PPI::Document::CORE:match, avg 4µs/call
174 Carp::croak("API CHANGE: Source code should only be passed to PPI::Document->new as a SCALAR reference");
175 }
176
177 # When loading from a filename, use the caching layer if it exists.
178144101µs if ( $CACHE ) {
179 my $file = $source;
180 my $source = PPI::Util::_slurp( $file );
181 unless ( ref $source ) {
182 # Errors returned as plain string
183 return $class->_error($source);
184 }
185
186 # Retrieve the document from the cache
187 my $document = $CACHE->get_document($source);
188 return $class->_setattr( $document, %attr ) if $document;
189
190 if ( $timeout ) {
191 eval {
192 local $SIG{ALRM} = sub { die "alarm\n" };
193 alarm( $timeout );
194 $document = PPI::Lexer->lex_source( $$source );
195 alarm( 0 );
196 };
197 } else {
198 $document = PPI::Lexer->lex_source( $$source );
199 }
200 if ( $document ) {
201 # Save in the cache
202 $CACHE->store_document( $document );
203 return $class->_setattr( $document, %attr );
204 }
205 } else {
20614456µs if ( $timeout ) {
207 eval {
208 local $SIG{ALRM} = sub { die "alarm\n" };
209 alarm( $timeout );
210 my $document = PPI::Lexer->lex_file( $source );
211 return $class->_setattr( $document, %attr ) if $document;
212 alarm( 0 );
213 };
214 } else {
215144988µs14413.2s my $document = PPI::Lexer->lex_file( $source );
# spent 13.2s making 144 calls to PPI::Lexer::lex_file, avg 92.0ms/call
2161442.06ms288804µs return $class->_setattr( $document, %attr ) if $document;
# spent 667µs making 144 calls to PPI::Document::_setattr, avg 5µs/call # spent 137µs making 144 calls to PPI::Util::TRUE, avg 952ns/call
217 }
218 }
219
220 } elsif ( _SCALAR0($source) ) {
221 if ( $timeout ) {
222 eval {
223 local $SIG{ALRM} = sub { die "alarm\n" };
224 alarm( $timeout );
225 my $document = PPI::Lexer->lex_source( $$source );
226 return $class->_setattr( $document, %attr ) if $document;
227 alarm( 0 );
228 };
229 } else {
230 my $document = PPI::Lexer->lex_source( $$source );
231 return $class->_setattr( $document, %attr ) if $document;
232 }
233
234 } elsif ( _ARRAY0($source) ) {
235 $source = join '', map { "$_\n" } @$source;
236 if ( $timeout ) {
237 eval {
238 local $SIG{ALRM} = sub { die "alarm\n" };
239 alarm( $timeout );
240 my $document = PPI::Lexer->lex_source( $source );
241 return $class->_setattr( $document, %attr ) if $document;
242 alarm( 0 );
243 };
244 } else {
245 my $document = PPI::Lexer->lex_source( $source );
246 return $class->_setattr( $document, %attr ) if $document;
247 }
248
249 } else {
250 $class->_error("Unknown object or reference was passed to PPI::Document::new");
251 }
252
253 # Pull and store the error from the lexer
254 my $errstr;
255 if ( _INSTANCE($@, 'PPI::Exception::Timeout') ) {
256 $errstr = 'Timed out while parsing document';
257 } elsif ( _INSTANCE($@, 'PPI::Exception') ) {
258 $errstr = $@->message;
259 } elsif ( $@ ) {
260 $errstr = $@;
261 $errstr =~ s/\sat line\s.+$//;
262 } elsif ( PPI::Lexer->errstr ) {
263 $errstr = PPI::Lexer->errstr;
264 } else {
265 $errstr = "Unknown error parsing Perl document";
266 }
267 PPI::Lexer->_clear;
268 $class->_error( $errstr );
269}
270
271sub load {
272 Carp::croak("API CHANGE: File names should now be passed to PPI::Document->new to load a file");
273}
274
275
# spent 667µs within PPI::Document::_setattr which was called 144 times, avg 5µs/call: # 144 times (667µs+0s) by PPI::Document::new at line 216, avg 5µs/call
sub _setattr {
276144158µs my ($class, $document, %attr) = @_;
277144188µs $document->{readonly} = !! $attr{readonly};
278144479µs return $document;
279}
280
281=pod
282
283=head2 set_cache $cache
284
285As of L<PPI> 1.100, C<PPI::Document> supports parser caching.
286
287The default cache class L<PPI::Cache> provides a L<Storable>-based
288caching or the parsed document based on the MD5 hash of the document as
289a string.
290
291The static C<set_cache> method is used to set the cache object for
292C<PPI::Document> to use when loading documents. It takes as argument
293a L<PPI::Cache> object (or something that C<isa> the same).
294
295If passed C<undef>, this method will stop using the current cache, if any.
296
297For more information on caching, see L<PPI::Cache>.
298
299Returns true on success, or C<undef> if not passed a valid param.
300
301=cut
302
303sub set_cache {
304 my $class = ref $_[0] ? ref shift : shift;
305
306 if ( defined $_[0] ) {
307 # Enable the cache
308 my $object = _INSTANCE(shift, 'PPI::Cache') or return undef;
309 $CACHE = $object;
310 } else {
311 # Disable the cache
312 $CACHE = undef;
313 }
314
315 1;
316}
317
318=pod
319
320=head2 get_cache
321
322If a document cache is currently set, the C<get_cache> method will
323return it.
324
325Returns a L<PPI::Cache> object, or C<undef> if there is no cache
326currently set for C<PPI::Document>.
327
328=cut
329
330sub get_cache {
331 $CACHE;
332}
333
- -
338#####################################################################
339# PPI::Document Instance Methods
340
341=pod
342
343=head2 readonly
344
345The C<readonly> attribute indicates if the document is intended to be
346read-only, and will never be modified. This is an advisory flag, that
347writers of L<PPI>-related systems may or may not use to enable
348optimisations and caches for your document.
349
350Returns true if the document is read-only or false if not.
351
352=cut
353
354sub readonly {
355 $_[0]->{readonly};
356}
357
358=pod
359
360=head2 tab_width [ $width ]
361
362In order to handle support for C<location> correctly, C<Documents>
363need to understand the concept of tabs and tab width. The C<tab_width>
364method is used to get and set the size of the tab width.
365
366At the present time, PPI only supports "naive" (width 1) tabs, but we do
367plan on supporting arbitrary, default and auto-sensing tab widths later.
368
369Returns the tab width as an integer, or C<die>s if you attempt to set the
370tab width.
371
372=cut
373
374
# spent 95.9ms within PPI::Document::tab_width which was called 79763 times, avg 1µs/call: # 79763 times (95.9ms+0s) by PPI::Document::_visual_length at line 740, avg 1µs/call
sub tab_width {
375797639.13ms my $self = shift;
37679763191ms return $self->{tab_width} unless @_;
377 $self->{tab_width} = shift;
378}
379
380=pod
381
382=head2 save
383
384 $document->save( $file )
385
386The C<save> method serializes the C<PPI::Document> object and saves the
387resulting Perl document to a file. Returns C<undef> on failure to open
388or write to the file.
389
390=cut
391
392sub save {
393 my $self = shift;
394 local *FILE;
395 open( FILE, '>', $_[0] ) or return undef;
396 print FILE $self->serialize or return undef;
397 close FILE or return undef;
398 return 1;
399}
400
401=pod
402
403=head2 serialize
404
405Unlike the C<content> method, which shows only the immediate content
406within an element, Document objects also have to be able to be written
407out to a file again.
408
409When doing this we need to take into account some additional factors.
410
411Primarily, we need to handle here-docs correctly, so that are written
412to the file in the expected place.
413
414The C<serialize> method generates the actual file content for a given
415Document object. The resulting string can be written straight to a file.
416
417Returns the serialized document as a string.
418
419=cut
420
421
# spent 1.23s (576ms+656ms) within PPI::Document::serialize which was called 144 times, avg 8.55ms/call: # 144 times (576ms+656ms) by Perl::Critic::Document::AUTOLOAD at line 41 of Perl/Critic/Document.pm, avg 8.55ms/call
sub serialize {
42214465µs my $self = shift;
4231447.81ms144431ms my @tokens = $self->tokens;
# spent 431ms making 144 calls to PPI::Node::tokens, avg 2.99ms/call
424
425 # The here-doc content buffer
42614497µs my $heredoc = '';
427
428 # Start the main loop
42914485µs my $output = '';
43014412.9ms foreach my $i ( 0 .. $#tokens ) {
4319422516.1ms my $Token = $tokens[$i];
432
433 # Handle normal tokens
43494225292ms9422591.6ms unless ( $Token->isa('PPI::Token::HereDoc') ) {
# spent 91.6ms making 94225 calls to UNIVERSAL::isa, avg 972ns/call
43594224104ms94224133ms my $content = $Token->content;
# spent 133ms making 94224 calls to PPI::Token::content, avg 1µs/call
436
437 # Handle the trivial cases
4389422413.0ms43µs unless ( $heredoc ne '' and $content =~ /\n/ ) {
# spent 3µs making 4 calls to PPI::Document::CORE:match, avg 700ns/call
4399422310.2ms $output .= $content;
4409422329.0ms next;
441 }
442
443 # We have pending here-doc content that needs to be
444 # inserted just after the first newline in the content.
44511µs if ( $content eq "\n" ) {
446 # Shortcut the most common case for speed
447 $output .= $content . $heredoc;
448 } else {
449 # Slower and more general version
450 $content =~ s/\n/\n$heredoc/;
451 $output .= $content;
452 }
453
4541500ns $heredoc = '';
4551300ns next;
456 }
457
458 # This token is a HereDoc.
459 # First, add the token content as normal, which in this
460 # case will definately not contain a newline.
46111µs11µs $output .= $Token->content;
# spent 1µs making 1 call to PPI::Token::content
462
463 # Now add all of the here-doc content to the heredoc buffer.
46413µs14µs foreach my $line ( $Token->heredoc ) {
# spent 4µs making 1 call to PPI::Token::HereDoc::heredoc
46552µs $heredoc .= $line;
466 }
467
4681500ns if ( $Token->{_damaged} ) {
469 # Special Case:
470 # There are a couple of warning/bug situations
471 # that can occur when a HereDoc content was read in
472 # from the end of a file that we silently allow.
473 #
474 # When writing back out to the file we have to
475 # auto-repair these problems if we arn't going back
476 # on to the end of the file.
477
478 # When calculating $last_line, ignore the final token if
479 # and only if it has a single newline at the end.
480 my $last_index = $#tokens;
481 if ( $tokens[$last_index]->{content} =~ /^[^\n]*\n$/ ) {
482 $last_index--;
483 }
484
485 # This is a two part test.
486 # First, are we on the last line of the
487 # content part of the file
488 my $last_line = List::MoreUtils::none {
489 $tokens[$_] and $tokens[$_]->{content} =~ /\n/
490 } (($i + 1) .. $last_index);
491 if ( ! defined $last_line ) {
492 # Handles the null list case
493 $last_line = 1;
494 }
495
496 # Secondly, are their any more here-docs after us,
497 # (with content or a terminator)
498 my $any_after = List::MoreUtils::any {
499 $tokens[$_]->isa('PPI::Token::HereDoc')
500 and (
501 scalar(@{$tokens[$_]->{_heredoc}})
502 or
503 defined $tokens[$_]->{_terminator_line}
504 )
505 } (($i + 1) .. $#tokens);
506 if ( ! defined $any_after ) {
507 # Handles the null list case
508 $any_after = '';
509 }
510
511 # We don't need to repair the last here-doc on the
512 # last line. But we do need to repair anything else.
513 unless ( $last_line and ! $any_after ) {
514 # Add a terminating string if it didn't have one
515 unless ( defined $Token->{_terminator_line} ) {
516 $Token->{_terminator_line} = $Token->{_terminator};
517 }
518
519 # Add a trailing newline to the terminating
520 # string if it didn't have one.
521 unless ( $Token->{_terminator_line} =~ /\n$/ ) {
522 $Token->{_terminator_line} .= "\n";
523 }
524 }
525 }
526
527 # Now add the termination line to the heredoc buffer
52811µs if ( defined $Token->{_terminator_line} ) {
529 $heredoc .= $Token->{_terminator_line};
530 }
531 }
532
533 # End of tokens
534
53514458µs if ( $heredoc ne '' ) {
536 # If the file doesn't end in a newline, we need to add one
537 # so that the here-doc content starts on the next line.
538 unless ( $output =~ /\n$/ ) {
539 $output .= "\n";
540 }
541
542 # Now we add the remaining here-doc content
543 # to the end of the file.
544 $output .= $heredoc;
545 }
546
5471443.36ms $output;
548}
549
550=pod
551
552=head2 hex_id
553
554The C<hex_id> method generates an unique identifier for the Perl document.
555
556This identifier is basically just the serialized document, with
557Unix-specific newlines, passed through MD5 to produce a hexadecimal string.
558
559This identifier is used by a variety of systems (such as L<PPI::Cache>
560and L<Perl::Metrics>) as a unique key against which to store or cache
561information about a document (or indeed, to cache the document itself).
562
563Returns a 32 character hexadecimal string.
564
565=cut
566
567sub hex_id {
568 PPI::Util::md5hex($_[0]->serialize);
569}
570
571=pod
572
573=head2 index_locations
574
575Within a document, all L<PPI::Element> objects can be considered to have a
576"location", a line/column position within the document when considered as a
577file. This position is primarily useful for debugging type activities.
578
579The method for finding the position of a single Element is a bit laborious,
580and very slow if you need to do it a lot. So the C<index_locations> method
581will index and save the locations of every Element within the Document in
582advance, making future calls to <PPI::Element::location> virtually free.
583
584Please note that this index should always be cleared using C<flush_locations>
585once you are finished with the locations. If content is added to or removed
586from the file, these indexed locations will be B<wrong>.
587
588=cut
589
590
# spent 3.24s (636ms+2.60) within PPI::Document::index_locations which was called 144 times, avg 22.5ms/call: # 144 times (636ms+2.60s) by Perl::Critic::Document::AUTOLOAD at line 41 of Perl/Critic/Document.pm, avg 22.5ms/call
sub index_locations {
59114452µs my $self = shift;
5921447.77ms144500ms my @tokens = $self->tokens;
# spent 500ms making 144 calls to PPI::Node::tokens, avg 3.47ms/call
593
594 # Whenever we hit a heredoc we will need to increment by
595 # the number of lines in it's content section when when we
596 # encounter the next token with a newline in it.
59714464µs my $heredoc = 0;
598
599 # Find the first Token without a location
60014466µs my ($first, $location) = ();
601144308µs foreach ( 0 .. $#tokens ) {
60214471µs my $Token = $tokens[$_];
603144118µs next if $Token->{_location};
604
605 # Found the first Token without a location
606 # Calculate the new location if needed.
60714459µs if ($_) {
608 $location =
609 $self->_add_location( $location, $tokens[$_ - 1], \$heredoc );
610 } else {
6111447.49ms288692µs my $logical_file =
# spent 414µs making 144 calls to PPI::Document::File::filename, avg 3µs/call # spent 278µs making 144 calls to UNIVERSAL::can, avg 2µs/call
612 $self->can('filename') ? $self->filename : undef;
613144279µs $location = [ 1, 1, 1, 1, $logical_file ];
614 }
61514429µs $first = $_;
61614496µs last;
617 }
618
619 # Calculate locations for the rest
620144113µs if ( defined $first ) {
621144149µs foreach ( $first .. $#tokens ) {
6229422523.1ms my $Token = $tokens[$_];
6239422538.8ms $Token->{_location} = $location;
62494225111ms942252.00s $location = $self->_add_location( $location, $Token, \$heredoc );
# spent 2.00s making 94225 calls to PPI::Document::_add_location, avg 21µs/call
625
626 # Add any here-doc lines to the counter
62794225345ms9422699.2ms if ( $Token->isa('PPI::Token::HereDoc') ) {
# spent 99.2ms making 94225 calls to UNIVERSAL::isa, avg 1µs/call # spent 3µs making 1 call to PPI::Token::HereDoc::heredoc
628 $heredoc += $Token->heredoc + 1;
629 }
630 }
631 }
632
6331444.06ms 1;
634}
635
636
# spent 2.00s (1.08+925ms) within PPI::Document::_add_location which was called 94225 times, avg 21µs/call: # 94225 times (1.08s+925ms) by PPI::Document::index_locations at line 624, avg 21µs/call
sub _add_location {
6379422520.2ms my ($self, $start, $Token, $heredoc) = @_;
6389422543.9ms my $content = $Token->{content};
639
640 # Does the content contain any newlines
64194225271ms9422533.7ms my $newlines =()= $content =~ /\n/g;
# spent 33.7ms making 94225 calls to PPI::Document::CORE:match, avg 358ns/call
64294225118ms94225286ms my ($logical_line, $logical_file) =
# spent 286ms making 94225 calls to PPI::Document::_logical_line_and_file, avg 3µs/call
643 $self->_logical_line_and_file($start, $Token, $newlines);
644
64594225380ms78626579ms unless ( $newlines ) {
# spent 579ms making 78626 calls to PPI::Document::_visual_length, avg 7µs/call
646 # Handle the simple case
647 return [
648 $start->[LOCATION_LINE],
649 $start->[LOCATION_CHARACTER] + length($content),
650 $start->[LOCATION_COLUMN]
651 + $self->_visual_length(
652 $content,
653 $start->[LOCATION_COLUMN]
654 ),
655 $logical_line,
656 $logical_file,
657 ];
658 }
659
660 # This is the more complex case where we hit or
661 # span a newline boundary.
662155993.79ms my $physical_line = $start->[LOCATION_LINE] + $newlines;
6631559913.5ms my $location = [ $physical_line, 1, 1, $logical_line, $logical_file ];
664155992.55ms if ( $heredoc and $$heredoc ) {
6651200ns $location->[LOCATION_LINE] += $$heredoc;
6661100ns $location->[LOCATION_LOGICAL_LINE] += $$heredoc;
6671200ns $$heredoc = 0;
668 }
669
670 # Does the token have additional characters
671 # after their last newline.
6721559957.5ms1559919.1ms if ( $content =~ /\n([^\n]+?)\z/ ) {
# spent 19.1ms making 15599 calls to PPI::Document::CORE:match, avg 1µs/call
67311371.17ms $location->[LOCATION_CHARACTER] += length($1);
67411371.67ms11378.08ms $location->[LOCATION_COLUMN] +=
# spent 8.08ms making 1137 calls to PPI::Document::_visual_length, avg 7µs/call
675 $self->_visual_length(
676 $1, $location->[LOCATION_COLUMN],
677 );
678 }
679
6801559938.9ms $location;
681}
682
683
# spent 286ms (256+29.9) within PPI::Document::_logical_line_and_file which was called 94225 times, avg 3µs/call: # 94225 times (256ms+29.9ms) by PPI::Document::_add_location at line 642, avg 3µs/call
sub _logical_line_and_file {
6849422520.1ms my ($self, $start, $Token, $newlines) = @_;
685
686 # Regex taken from perlsyn, with the correction that there's no space
687 # required between the line number and the file name.
6889422522.6ms if ($start->[LOCATION_CHARACTER] == 1) {
6891446281.7ms2725625.7ms if ( $Token->isa('PPI::Token::Comment') ) {
# spent 25.7ms making 27256 calls to UNIVERSAL::isa, avg 943ns/call
69016684.81ms33363.39ms if (
# spent 2.55ms making 1668 calls to PPI::Token::content, avg 2µs/call # spent 843µs making 1668 calls to PPI::Document::CORE:match, avg 505ns/call
691 $Token->content =~ m<
692 \A
693 \# \s*
694 line \s+
695 (\d+) \s*
696 (?: (\"?) ([^\"]* [^\s\"]) \2 )?
697 \s*
698 \z
699 >xms
700 ) {
701 return $1, ($3 || $start->[LOCATION_LOGICAL_FILE]);
702 }
703 }
704 elsif ( $Token->isa('PPI::Token::Pod') ) {
705146337µs146318µs my $content = $Token->content;
# spent 318µs making 146 calls to PPI::Token::content, avg 2µs/call
70614615µs my $line;
70714684µs my $file = $start->[LOCATION_LOGICAL_FILE];
70814624µs my $end_of_directive;
709146835µs146478µs while (
# spent 478µs making 146 calls to PPI::Document::CORE:match, avg 3µs/call
710 $content =~ m<
711 ^
712 \# \s*?
713 line \s+?
714 (\d+) (?: (?! \n) \s)*
715 (?: (\"?) ([^\"]*? [^\s\"]) \2 )??
716 \s*?
717 $
718 >xmsg
719 ) {
720 ($line, $file) = ($1, ( $3 || $file ) );
721 $end_of_directive = pos $content;
722 }
723
72414677µs if (defined $line) {
725 pos $content = $end_of_directive;
726 my $post_directive_newlines =()= $content =~ m< \G [^\n]* \n >xmsg;
727 return $line + $post_directive_newlines - 1, $file;
728 }
729 }
730 }
731
732 return
73394225293ms $start->[LOCATION_LOGICAL_LINE] + $newlines,
734 $start->[LOCATION_LOGICAL_FILE];
735}
736
737
# spent 587ms (466+121) within PPI::Document::_visual_length which was called 79763 times, avg 7µs/call: # 78626 times (460ms+119ms) by PPI::Document::_add_location at line 645, avg 7µs/call # 1137 times (6.11ms+1.98ms) by PPI::Document::_add_location at line 674, avg 7µs/call
sub _visual_length {
7387976321.1ms my ($self, $content, $pos) = @_;
739
7407976366.9ms7976395.9ms my $tab_width = $self->tab_width;
# spent 95.9ms making 79763 calls to PPI::Document::tab_width, avg 1µs/call
741797631.09ms my ($length, $vis_inc);
742
74379763363ms7976325.5ms return length $content if $content !~ /\t/;
# spent 25.5ms making 79763 calls to PPI::Document::CORE:match, avg 319ns/call
744
745 # Split the content in tab and non-tab parts and calculate the
746 # "visual increase" of each part.
747 for my $part ( split(/(\t)/, $content) ) {
748 if ($part eq "\t") {
749 $vis_inc = $tab_width - ($pos-1) % $tab_width;
750 }
751 else {
752 $vis_inc = length $part;
753 }
754 $length += $vis_inc;
755 $pos += $vis_inc;
756 }
757
758 $length;
759}
760
761=pod
762
763=head2 flush_locations
764
765When no longer needed, the C<flush_locations> method clears all location data
766from the tokens.
767
768=cut
769
770sub flush_locations {
771 shift->_flush_locations(@_);
772}
773
774=pod
775
776=head2 normalized
777
778The C<normalized> method is used to generate a "Layer 1"
779L<PPI::Document::Normalized> object for the current Document.
780
781A "normalized" Perl Document is an arbitrary structure that removes any
782irrelevant parts of the document and refactors out variations in style,
783to attempt to approach something that is closer to the "true meaning"
784of the Document.
785
786See L<PPI::Normal> for more information on document normalization and
787the tasks for which it is useful.
788
789Returns a L<PPI::Document::Normalized> object, or C<undef> on error.
790
791=cut
792
793sub normalized {
794 # The normalization process will utterly destroy and mangle
795 # anything passed to it, so we are going to only give it a
796 # clone of ourself.
797 PPI::Normal->process( $_[0]->clone );
798}
799
800=pod
801
802=head1 complete
803
804The C<complete> method is used to determine if a document is cleanly
805structured, all braces are closed, the final statement is
806fully terminated and all heredocs are fully entered.
807
808Returns true if the document is complete or false if not.
809
810=cut
811
812sub complete {
813 my $self = shift;
814
815 # Every structure has to be complete
816 $self->find_any( sub {
817 $_[1]->isa('PPI::Structure')
818 and
819 ! $_[1]->complete
820 } )
821 and return '';
822
823 # Strip anything that isn't a statement off the end
824 my @child = $self->children;
825 while ( @child and not $child[-1]->isa('PPI::Statement') ) {
826 pop @child;
827 }
828
829 # We must have at least one statement
830 return '' unless @child;
831
832 # Check the completeness of the last statement
833 return $child[-1]->_complete;
834}
835
- -
840#####################################################################
841# PPI::Node Methods
842
843# We are a scope boundary
844### XS -> PPI/XS.xs:_PPI_Document__scope 0.903+
845sub scope { 1 }
846
- -
851#####################################################################
852# PPI::Element Methods
853
854sub insert_before {
855 return undef;
856 # die "Cannot insert_before a PPI::Document";
857}
858
859sub insert_after {
860 return undef;
861 # die "Cannot insert_after a PPI::Document";
862}
863
864sub replace {
865 return undef;
866 # die "Cannot replace a PPI::Document";
867}
868
- -
873#####################################################################
874# Error Handling
875
876# Set the error message
877sub _error {
878 $errstr = $_[1];
879 undef;
880}
881
882# Clear the error message.
883# Returns the object as a convenience.
884sub _clear {
885 $errstr = '';
886 $_[0];
887}
888
889=pod
890
891=head2 errstr
892
893For error that occur when loading and saving documents, you can use
894C<errstr>, as either a static or object method, to access the error message.
895
896If a Document loads or saves without error, C<errstr> will return false.
897
898=cut
899
900sub errstr {
901 $errstr;
902}
903
- -
908#####################################################################
909# Native Storable Support
910
911sub STORABLE_freeze {
912 my $self = shift;
913 my $class = ref $self;
914 my %hash = %$self;
915 return ($class, \%hash);
916}
917
918sub STORABLE_thaw {
919 my ($self, undef, $class, $hash) = @_;
920 bless $self, $class;
921 foreach ( keys %$hash ) {
922 $self->{$_} = delete $hash->{$_};
923 }
924 $self->__link_children;
925}
926
92712µs1;
928
929=pod
930
931=head1 TO DO
932
933- May need to overload some methods to forcefully prevent Document
934objects becoming children of another Node.
935
936=head1 SUPPORT
937
938See the L<support section|PPI/SUPPORT> in the main module.
939
940=head1 AUTHOR
941
942Adam Kennedy E<lt>adamk@cpan.orgE<gt>
943
944=head1 SEE ALSO
945
946L<PPI>, L<http://ali.as/>
947
948=head1 COPYRIGHT
949
950Copyright 2001 - 2011 Adam Kennedy.
951
952This program is free software; you can redistribute
953it and/or modify it under the same terms as Perl itself.
954
955The full text of the license can be found in the
956LICENSE file included with this module.
957
958=cut
 
# spent 80.1ms within PPI::Document::CORE:match which was called 191549 times, avg 418ns/call: # 94225 times (33.7ms+0s) by PPI::Document::_add_location at line 641, avg 358ns/call # 79763 times (25.5ms+0s) by PPI::Document::_visual_length at line 743, avg 319ns/call # 15599 times (19.1ms+0s) by PPI::Document::_add_location at line 672, avg 1µs/call # 1668 times (843µs+0s) by PPI::Document::_logical_line_and_file at line 690, avg 505ns/call # 146 times (478µs+0s) by PPI::Document::_logical_line_and_file at line 709, avg 3µs/call # 144 times (506µs+0s) by PPI::Document::new at line 173, avg 4µs/call # 4 times (3µs+0s) by PPI::Document::serialize at line 438, avg 700ns/call
sub PPI::Document::CORE:match; # opcode
Report produced by the NYTProf 6.01 Perl profiler, developed by Tim Bunce and Adam Kaplan.