← 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