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

Filename/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/PPIx/Utilities/Node.pm
StatementsExecuted 20 statements in 760µs
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
111168µs384µsPPIx::Utilities::Node::::BEGIN@16PPIx::Utilities::Node::BEGIN@16
11115µs15µsPPIx::Utilities::Node::::BEGIN@3PPIx::Utilities::Node::BEGIN@3
11114µs26µsPPIx::Utilities::Node::::BEGIN@12PPIx::Utilities::Node::BEGIN@12
1118µs139µsPPIx::Utilities::Node::::BEGIN@19PPIx::Utilities::Node::BEGIN@19
1117µs27µsPPIx::Utilities::Node::::BEGIN@9PPIx::Utilities::Node::BEGIN@9
1117µs18µsPPIx::Utilities::Node::::BEGIN@4PPIx::Utilities::Node::BEGIN@4
1117µs11µsPPIx::Utilities::Node::::BEGIN@5PPIx::Utilities::Node::BEGIN@5
1117µs26µsPPIx::Utilities::Node::::BEGIN@13PPIx::Utilities::Node::BEGIN@13
0000s0sPPIx::Utilities::Node::::_get_fragment_for_split_ppi_nodePPIx::Utilities::Node::_get_fragment_for_split_ppi_node
0000s0sPPIx::Utilities::Node::::_push_fragmentPPIx::Utilities::Node::_push_fragment
0000s0sPPIx::Utilities::Node::::_split_ppi_node_by_namespace_in_lexical_scopePPIx::Utilities::Node::_split_ppi_node_by_namespace_in_lexical_scope
0000s0sPPIx::Utilities::Node::::_split_ppi_node_by_namespace_singlePPIx::Utilities::Node::_split_ppi_node_by_namespace_single
0000s0sPPIx::Utilities::Node::::split_ppi_node_by_namespacePPIx::Utilities::Node::split_ppi_node_by_namespace
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package PPIx::Utilities::Node;
2
3236µs115µs
# spent 15µs within PPIx::Utilities::Node::BEGIN@3 which was called: # once (15µs+0s) by Perl::Critic::Document::BEGIN@22 at line 3
use 5.006001;
# spent 15µs making 1 call to PPIx::Utilities::Node::BEGIN@3
4218µs230µs
# spent 18µs (7+11) within PPIx::Utilities::Node::BEGIN@4 which was called: # once (7µs+11µs) by Perl::Critic::Document::BEGIN@22 at line 4
use strict;
# spent 18µs making 1 call to PPIx::Utilities::Node::BEGIN@4 # spent 11µs making 1 call to strict::import
5226µs216µs
# spent 11µs (7+5) within PPIx::Utilities::Node::BEGIN@5 which was called: # once (7µs+5µs) by Perl::Critic::Document::BEGIN@22 at line 5
use warnings;
# spent 11µs making 1 call to PPIx::Utilities::Node::BEGIN@5 # spent 5µs making 1 call to warnings::import
6
71600nsour $VERSION = '1.001000';
8
9227µs246µs
# spent 27µs (7+20) within PPIx::Utilities::Node::BEGIN@9 which was called: # once (7µs+20µs) by Perl::Critic::Document::BEGIN@22 at line 9
use Readonly;
# spent 27µs making 1 call to PPIx::Utilities::Node::BEGIN@9 # spent 20µs making 1 call to Exporter::import
10
11
12342µs238µs
# spent 26µs (14+12) within PPIx::Utilities::Node::BEGIN@12 which was called: # once (14µs+12µs) by Perl::Critic::Document::BEGIN@22 at line 12
use PPI::Document::Fragment 1.208 qw< >;
# spent 26µs making 1 call to PPIx::Utilities::Node::BEGIN@12 # spent 12µs making 1 call to UNIVERSAL::VERSION
13221µs246µs
# spent 26µs (7+20) within PPIx::Utilities::Node::BEGIN@13 which was called: # once (7µs+20µs) by Perl::Critic::Document::BEGIN@22 at line 13
use Scalar::Util qw< refaddr >;
# spent 26µs making 1 call to PPIx::Utilities::Node::BEGIN@13 # spent 20µs making 1 call to Exporter::import
14
15
16291µs1384µs
# spent 384µs (168+216) within PPIx::Utilities::Node::BEGIN@16 which was called: # once (168µs+216µs) by Perl::Critic::Document::BEGIN@22 at line 16
use PPIx::Utilities::Exception::Bug qw< >;
# spent 384µs making 1 call to PPIx::Utilities::Node::BEGIN@16
17
18
192494µs2270µs
# spent 139µs (8+131) within PPIx::Utilities::Node::BEGIN@19 which was called: # once (8µs+131µs) by Perl::Critic::Document::BEGIN@22 at line 19
use base 'Exporter';
# spent 139µs making 1 call to PPIx::Utilities::Node::BEGIN@19 # spent 131µs making 1 call to base::import
20
2112µs128µsReadonly::Array our @EXPORT_OK => qw<
# spent 28µs making 1 call to Readonly::Array
22 split_ppi_node_by_namespace
23>;
24
25
26sub split_ppi_node_by_namespace {
27 my ($node) = @_;
28
29 # Ensure we don't screw up the original.
30 $node = $node->clone();
31
32 # We want to make sure that we have locations prior to things being split
33 # up, if we can, but don't worry about it if we don't.
34 eval { $node->location(); }; ## no critic (RequireCheckingReturnValueOfEval)
35
36 if ( my $single_namespace = _split_ppi_node_by_namespace_single($node) ) {
37 return $single_namespace;
38 } # end if
39
40 my %nodes_by_namespace;
41 _split_ppi_node_by_namespace_in_lexical_scope(
42 $node, 'main', undef, \%nodes_by_namespace,
43 );
44
45 return \%nodes_by_namespace;
46} # end split_ppi_node_by_namespace()
47
48
49# Handle the case where there's only one.
50sub _split_ppi_node_by_namespace_single {
51 my ($node) = @_;
52
53 my $package_statements = $node->find('PPI::Statement::Package');
54
55 if ( not $package_statements or not @{$package_statements} ) {
56 return { main => [$node] };
57 } # end if
58
59 if (@{$package_statements} == 1) {
60 my $package_statement = $package_statements->[0];
61 my $package_address = refaddr $package_statement;
62
63 # Yes, child and not schild.
64 my $first_child = $node->child(0);
65 if (
66 $package_address == refaddr $node
67 or $first_child and $package_address == refaddr $first_child
68 ) {
69 return { $package_statement->namespace() => [$node] };
70 } # end if
71 } # end if
72
73 return;
74} # end _split_ppi_node_by_namespace_single()
75
76
77sub _split_ppi_node_by_namespace_in_lexical_scope {
78 my ($node, $initial_namespace, $initial_fragment, $nodes_by_namespace)
79 = @_;
80
81 my %scope_fragments_by_namespace;
82
83 # I certainly hope a value isn't going to exist at address 0.
84 my $initial_fragment_address = refaddr $initial_fragment || 0;
85 my ($namespace, $fragment) = ($initial_namespace, $initial_fragment);
86
87 if ($initial_fragment) {
88 $scope_fragments_by_namespace{$namespace} = $initial_fragment;
89 } # end if
90
91 foreach my $child ( $node->children() ) {
92 if ( $child->isa('PPI::Statement::Package') ) {
93 if ($fragment) {
94 _push_fragment($nodes_by_namespace, $namespace, $fragment);
95
96 undef $fragment;
97 } # end if
98
99 $namespace = $child->namespace();
100 } elsif (
101 $child->isa('PPI::Statement::Compound')
102 or $child->isa('PPI::Statement::Given')
103 or $child->isa('PPI::Statement::When')
104 ) {
105 my $block;
106 my @components = $child->children();
107 while (not $block and my $component = shift @components) {
108 if ( $component->isa('PPI::Structure::Block') ) {
109 $block = $component;
110 } # end if
111 } # end while
112
113 if ($block) {
114 if (not $fragment) {
115 $fragment = _get_fragment_for_split_ppi_node(
116 $nodes_by_namespace,
117 \%scope_fragments_by_namespace,
118 $namespace,
119 );
120 } # end if
121
122 _split_ppi_node_by_namespace_in_lexical_scope(
123 $block, $namespace, $fragment, $nodes_by_namespace,
124 );
125 } # end if
126 } # end if
127
128 $fragment = _get_fragment_for_split_ppi_node(
129 $nodes_by_namespace, \%scope_fragments_by_namespace, $namespace,
130 );
131
132 if ($initial_fragment_address != refaddr $fragment) {
133 # Need to fix these to use exceptions. Thankfully the P::C tests
134 # will insist that this happens.
135 $child->remove()
136 or PPIx::Utilities::Exception::Bug->throw(
137 'Could not remove child from parent.'
138 );
139 $fragment->add_element($child)
140 or PPIx::Utilities::Exception::Bug->throw(
141 'Could not add child to fragment.'
142 );
143 } # end if
144 } # end foreach
145
146 return;
147} # end _split_ppi_node_by_namespace_in_lexical_scope()
148
149
150sub _get_fragment_for_split_ppi_node {
151 my ($nodes_by_namespace, $scope_fragments_by_namespace, $namespace) = @_;
152
153 my $fragment;
154 if ( not $fragment = $scope_fragments_by_namespace->{$namespace} ) {
155 $fragment = PPI::Document::Fragment->new();
156 $scope_fragments_by_namespace->{$namespace} = $fragment;
157 _push_fragment($nodes_by_namespace, $namespace, $fragment);
158 } # end if
159
160 return $fragment;
161} # end _get_fragment_for_split_ppi_node()
162
163
164# Due to $fragment being passed into recursive calls to
165# _split_ppi_node_by_namespace_in_lexical_scope(), we can end up attempting to
166# put the same fragment into a namespace's nodes multiple times.
167sub _push_fragment {
168 my ($nodes_by_namespace, $namespace, $fragment) = @_;
169
170 my $nodes = $nodes_by_namespace->{$namespace} ||= [];
171
172 if (not @{$nodes} or refaddr $nodes->[-1] != refaddr $fragment) {
173 push @{$nodes}, $fragment;
174 } # end if
175
176 return;
177} # end _push_fragment()
178
179
18013µs1;
181
182__END__
Report produced by the NYTProf 6.01 Perl profiler, developed by Tim Bunce and Adam Kaplan.