← 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/Normalized.pm
StatementsExecuted 16 statements in 850µs
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11111µs23µsPPI::Document::Normalized::::BEGIN@43PPI::Document::Normalized::BEGIN@43
1119µs40µsPPI::Document::Normalized::::BEGIN@44PPI::Document::Normalized::BEGIN@44
1118µs26µsPPI::Document::Normalized::::BEGIN@53PPI::Document::Normalized::BEGIN@53
1117µs29µsPPI::Document::Normalized::::BEGIN@45PPI::Document::Normalized::BEGIN@45
1116µs26µsPPI::Document::Normalized::::BEGIN@48PPI::Document::Normalized::BEGIN@48
1116µs22µsPPI::Document::Normalized::::BEGIN@54PPI::Document::Normalized::BEGIN@54
1113µs3µsPPI::Document::Normalized::::BEGIN@46PPI::Document::Normalized::BEGIN@46
1113µs3µsPPI::Document::Normalized::::BEGIN@49PPI::Document::Normalized::BEGIN@49
0000s0sPPI::Document::Normalized::::DESTROYPPI::Document::Normalized::DESTROY
0000s0sPPI::Document::Normalized::::_DocumentPPI::Document::Normalized::_Document
0000s0sPPI::Document::Normalized::::_equal_ARRAYPPI::Document::Normalized::_equal_ARRAY
0000s0sPPI::Document::Normalized::::_equal_CODEPPI::Document::Normalized::_equal_CODE
0000s0sPPI::Document::Normalized::::_equal_GLOBPPI::Document::Normalized::_equal_GLOB
0000s0sPPI::Document::Normalized::::_equal_HASHPPI::Document::Normalized::_equal_HASH
0000s0sPPI::Document::Normalized::::_equal_IOPPI::Document::Normalized::_equal_IO
0000s0sPPI::Document::Normalized::::_equal_REFPPI::Document::Normalized::_equal_REF
0000s0sPPI::Document::Normalized::::_equal_SCALARPPI::Document::Normalized::_equal_SCALAR
0000s0sPPI::Document::Normalized::::_equal_blessedPPI::Document::Normalized::_equal_blessed
0000s0sPPI::Document::Normalized::::_equal_referencePPI::Document::Normalized::_equal_reference
0000s0sPPI::Document::Normalized::::equalPPI::Document::Normalized::equal
0000s0sPPI::Document::Normalized::::functionsPPI::Document::Normalized::functions
0000s0sPPI::Document::Normalized::::newPPI::Document::Normalized::new
0000s0sPPI::Document::Normalized::::versionPPI::Document::Normalized::version
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::Normalized;
2
3=pod
4
5=head1 NAME
6
7PPI::Document::Normalized - A normalized Perl Document
8
9=head1 DESCRIPTION
10
11A C<Normalized Document> object is the result of the normalization process
12contained in the L<PPI::Normal> class. See the documentation for
13L<PPI::Normal> for more information.
14
15The object contains a version stamp and function list for the version
16of L<PPI::Normal> used to create it, and a processed and delinked
17L<PPI::Document> object.
18
19Typically, the Document object will have been mangled by the normalization
20process in a way that would make it fatal to try to actually DO anything
21with it.
22
23Put simply, B<never> use the Document object after normalization.
24B<YOU HAVE BEEN WARNED!>
25
26The object is designed the way it is to provide a bias towards false
27negatives. A comparison between two ::Normalized object will only return
28true if they were produced by the same version of PPI::Normal, with the
29same set of normalization functions (in the same order).
30
31You may get false negatives if you are caching objects across an upgrade.
32
33Please note that this is done for security purposes, as there are many
34cases in which low layer normalization is likely to be done as part of
35a code security process, and false positives could be highly dangerous.
36
37=head1 METHODS
38
39=cut
40
41# For convenience (and since this isn't really a public class), import
42# the methods we will need from Scalar::Util.
43223µs235µs
# spent 23µs (11+12) within PPI::Document::Normalized::BEGIN@43 which was called: # once (11µs+12µs) by PPI::BEGIN@26 at line 43
use strict;
# spent 23µs making 1 call to PPI::Document::Normalized::BEGIN@43 # spent 12µs making 1 call to strict::import
44223µs272µs
# spent 40µs (9+32) within PPI::Document::Normalized::BEGIN@44 which was called: # once (9µs+32µs) by PPI::BEGIN@26 at line 44
use Scalar::Util qw{refaddr reftype blessed};
# spent 40µs making 1 call to PPI::Document::Normalized::BEGIN@44 # spent 32µs making 1 call to Exporter::import
45218µs251µs
# spent 29µs (7+22) within PPI::Document::Normalized::BEGIN@45 which was called: # once (7µs+22µs) by PPI::BEGIN@26 at line 45
use Params::Util qw{_INSTANCE _ARRAY};
# spent 29µs making 1 call to PPI::Document::Normalized::BEGIN@45 # spent 22µs making 1 call to Exporter::import
46218µs13µs
# spent 3µs within PPI::Document::Normalized::BEGIN@46 which was called: # once (3µs+0s) by PPI::BEGIN@26 at line 46
use PPI::Util ();
# spent 3µs making 1 call to PPI::Document::Normalized::BEGIN@46
47
48223µs247µs
# spent 26µs (6+20) within PPI::Document::Normalized::BEGIN@48 which was called: # once (6µs+20µs) by PPI::BEGIN@26 at line 48
use vars qw{$VERSION};
# spent 26µs making 1 call to PPI::Document::Normalized::BEGIN@48 # spent 20µs making 1 call to vars::import
49
# spent 3µs within PPI::Document::Normalized::BEGIN@49 which was called: # once (3µs+0s) by PPI::BEGIN@26 at line 51
BEGIN {
5016µs $VERSION = '1.215';
51118µs13µs}
# spent 3µs making 1 call to PPI::Document::Normalized::BEGIN@49
52
53227µs244µs
# spent 26µs (8+18) within PPI::Document::Normalized::BEGIN@53 which was called: # once (8µs+18µs) by PPI::BEGIN@26 at line 53
use overload 'bool' => \&PPI::Util::TRUE;
# spent 26µs making 1 call to PPI::Document::Normalized::BEGIN@53 # spent 18µs making 1 call to overload::import
542692µs237µs
# spent 22µs (6+16) within PPI::Document::Normalized::BEGIN@54 which was called: # once (6µs+16µs) by PPI::BEGIN@26 at line 54
use overload '==' => 'equal';
# spent 22µs making 1 call to PPI::Document::Normalized::BEGIN@54 # spent 16µs making 1 call to overload::import
55
- -
61#####################################################################
62# Constructor and Accessors
63
64=pod
65
66=head2 new
67
68The C<new> method is intended for use only by the L<PPI::Normal> class,
69and to get ::Normalized objects, you are highly recommended to use
70either that module, or the C<normalized> method of the L<PPI::Document>
71object itself.
72
73=cut
74
75sub new {
76 my $class = shift;
77 my %args = @_;
78
79 # Check the required params
80 my $Document = _INSTANCE($args{Document}, 'PPI::Document') or return undef;
81 my $version = $args{version} or return undef;
82 my $functions = _ARRAY($args{functions}) or return undef;
83
84 # Create the object
85 my $self = bless {
86 Document => $Document,
87 version => $version,
88 functions => $functions,
89 }, $class;
90
91 $self;
92}
93
94sub _Document { $_[0]->{Document} }
95
96=pod
97
98=head2 version
99
100The C<version> accessor returns the L<PPI::Normal> version used to create
101the object.
102
103=cut
104
105sub version { $_[0]->{version} }
106
107=pod
108
109=head2 functions
110
111The C<functions> accessor returns a reference to an array of the
112normalization functions (in order) that were called when creating
113the object.
114
115=cut
116
117sub functions { $_[0]->{functions} }
118
- -
123#####################################################################
124# Comparison Methods
125
126=pod
127
128=head2 equal $Normalized
129
130The C<equal> method is the primary comparison method, taking another
131PPI::Document::Normalized object, and checking for equivalence to it.
132
133The C<==> operator is also overload to this method, so that you can
134do something like the following:
135
136 my $first = PPI::Document->load('first.pl');
137 my $second = PPI::Document->load('second.pl');
138
139 if ( $first->normalized == $second->normalized ) {
140 print "The two documents are equivalent";
141 }
142
143Returns true if the normalized documents are equivalent, false if not,
144or C<undef> if there is an error.
145
146=cut
147
148sub equal {
149 my $self = shift;
150 my $other = _INSTANCE(shift, 'PPI::Document::Normalized') or return undef;
151
152 # Prevent multiple concurrent runs
153 return undef if $self->{processing};
154
155 # Check the version and function list first
156 return '' unless $self->version eq $other->version;
157 $self->_equal_ARRAY( $self->functions, $other->functions ) or return '';
158
159 # Do the main comparison run
160 $self->{seen} = {};
161 my $rv = $self->_equal_blessed( $self->_Document, $other->_Document );
162 delete $self->{seen};
163
164 $rv;
165}
166
167# Check that two objects are matched
168sub _equal_blessed {
169 my ($self, $this, $that) = @_;
170 my ($bthis, $bthat) = (blessed $this, blessed $that);
171 $bthis and $bthat and $bthis eq $bthat or return '';
172
173 # Check the object as a reference
174 $self->_equal_reference( $this, $that );
175}
176
177# Check that two references match their types
178sub _equal_reference {
179 my ($self, $this, $that) = @_;
180 my ($rthis, $rthat) = (refaddr $this, refaddr $that);
181 $rthis and $rthat or return undef;
182
183 # If we have seen this before, are the pointing
184 # is it the same one we saw in both sides
185 my $seen = $self->{seen}->{$rthis};
186 if ( $seen and $seen ne $rthat ) {
187 return '';
188 }
189
190 # Check the reference types
191 my ($tthis, $tthat) = (reftype $this, reftype $that);
192 $tthis and $tthat and $tthis eq $tthat or return undef;
193
194 # Check the children of the reference type
195 $self->{seen}->{$rthis} = $rthat;
196 my $method = "_equal_$tthat";
197 my $rv = $self->$method( $this, $that );
198 delete $self->{seen}->{$rthis};
199 $rv;
200}
201
202# Compare the children of two SCALAR references
203sub _equal_SCALAR {
204 my ($self, $this, $that) = @_;
205 my ($cthis, $cthat) = ($$this, $$that);
206 return $self->_equal_blessed( $cthis, $cthat ) if blessed $cthis;
207 return $self->_equal_reference( $cthis, $cthat ) if ref $cthis;
208 return (defined $cthat and $cthis eq $cthat) if defined $cthis;
209 ! defined $cthat;
210}
211
212# For completeness sake, lets just treat REF as a specialist SCALAR case
213sub _equal_REF { shift->_equal_SCALAR(@_) }
214
215# Compare the children of two ARRAY references
216sub _equal_ARRAY {
217 my ($self, $this, $that) = @_;
218
219 # Compare the number of elements
220 scalar(@$this) == scalar(@$that) or return '';
221
222 # Check each element in the array.
223 # Descend depth-first.
224 foreach my $i ( 0 .. scalar(@$this) ) {
225 my ($cthis, $cthat) = ($this->[$i], $that->[$i]);
226 if ( blessed $cthis ) {
227 return '' unless $self->_equal_blessed( $cthis, $cthat );
228 } elsif ( ref $cthis ) {
229 return '' unless $self->_equal_reference( $cthis, $cthat );
230 } elsif ( defined $cthis ) {
231 return '' unless (defined $cthat and $cthis eq $cthat);
232 } else {
233 return '' if defined $cthat;
234 }
235 }
236
237 1;
238}
239
240# Compare the children of a HASH reference
241sub _equal_HASH {
242 my ($self, $this, $that) = @_;
243
244 # Compare the number of keys
245 return '' unless scalar(keys %$this) == scalar(keys %$that);
246
247 # Compare each key, descending depth-first.
248 foreach my $k ( keys %$this ) {
249 return '' unless exists $that->{$k};
250 my ($cthis, $cthat) = ($this->{$k}, $that->{$k});
251 if ( blessed $cthis ) {
252 return '' unless $self->_equal_blessed( $cthis, $cthat );
253 } elsif ( ref $cthis ) {
254 return '' unless $self->_equal_reference( $cthis, $cthat );
255 } elsif ( defined $cthis ) {
256 return '' unless (defined $cthat and $cthis eq $cthat);
257 } else {
258 return '' if defined $cthat;
259 }
260 }
261
262 1;
263}
264
265# We do not support GLOB comparisons
266sub _equal_GLOB {
267 my ($self, $this, $that) = @_;
268 warn('GLOB comparisons are not supported');
269 '';
270}
271
272# We do not support CODE comparisons
273sub _equal_CODE {
274 my ($self, $this, $that) = @_;
275 refaddr $this == refaddr $that;
276}
277
278# We don't support IO comparisons
279sub _equal_IO {
280 my ($self, $this, $that) = @_;
281 warn('IO comparisons are not supported');
282 '';
283}
284
285sub DESTROY {
286 # Take the screw up Document with us
287 if ( $_[0]->{Document} ) {
288 $_[0]->{Document}->DESTROY;
289 delete $_[0]->{Document};
290 }
291}
292
29312µs1;
294
295=pod
296
297=head1 SUPPORT
298
299See the L<support section|PPI/SUPPORT> in the main module.
300
301=head1 AUTHOR
302
303Adam Kennedy E<lt>adamk@cpan.orgE<gt>
304
305=head1 COPYRIGHT
306
307Copyright 2005 - 2011 Adam Kennedy.
308
309This program is free software; you can redistribute
310it and/or modify it under the same terms as Perl itself.
311
312The full text of the license can be found in the
313LICENSE file included with this module.
314
315=cut
316
Report produced by the NYTProf 6.01 Perl profiler, developed by Tim Bunce and Adam Kaplan.