line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Perl::Metrics::Simple::Analysis::File; |
2
|
6
|
|
|
6
|
|
111794
|
use strict; |
|
6
|
|
|
|
|
22
|
|
|
6
|
|
|
|
|
172
|
|
3
|
6
|
|
|
6
|
|
31
|
use warnings; |
|
6
|
|
|
|
|
11
|
|
|
6
|
|
|
|
|
184
|
|
4
|
|
|
|
|
|
|
|
5
|
6
|
|
|
6
|
|
30
|
use Carp qw(cluck confess); |
|
6
|
|
|
|
|
12
|
|
|
6
|
|
|
|
|
344
|
|
6
|
6
|
|
|
6
|
|
40
|
use Data::Dumper; |
|
6
|
|
|
|
|
13
|
|
|
6
|
|
|
|
|
235
|
|
7
|
6
|
|
|
6
|
|
32
|
use English qw(-no_match_vars); |
|
6
|
|
|
|
|
9
|
|
|
6
|
|
|
|
|
64
|
|
8
|
6
|
|
|
6
|
|
2544
|
use Perl::Metrics::Simple::Analysis; |
|
6
|
|
|
|
|
14
|
|
|
6
|
|
|
|
|
191
|
|
9
|
6
|
|
|
6
|
|
39
|
use PPI 1.113; |
|
6
|
|
|
|
|
151
|
|
|
6
|
|
|
|
|
114
|
|
10
|
6
|
|
|
6
|
|
36
|
use PPI::Document; |
|
6
|
|
|
|
|
13
|
|
|
6
|
|
|
|
|
189
|
|
11
|
6
|
|
|
6
|
|
30
|
use Readonly; |
|
6
|
|
|
|
|
11
|
|
|
6
|
|
|
|
|
13040
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
our $VERSION = 'v1.0.1'; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
Readonly::Scalar my $ALL_NEWLINES_REGEX => |
16
|
|
|
|
|
|
|
qr/ ( \Q$INPUT_RECORD_SEPARATOR\E ) /sxm; |
17
|
|
|
|
|
|
|
Readonly::Array our @DEFAULT_LOGIC_OPERATORS => qw( |
18
|
|
|
|
|
|
|
! |
19
|
|
|
|
|
|
|
!~ |
20
|
|
|
|
|
|
|
&& |
21
|
|
|
|
|
|
|
&&= |
22
|
|
|
|
|
|
|
// |
23
|
|
|
|
|
|
|
< |
24
|
|
|
|
|
|
|
<<= |
25
|
|
|
|
|
|
|
<=> |
26
|
|
|
|
|
|
|
== |
27
|
|
|
|
|
|
|
=~ |
28
|
|
|
|
|
|
|
> |
29
|
|
|
|
|
|
|
>>= |
30
|
|
|
|
|
|
|
? |
31
|
|
|
|
|
|
|
and |
32
|
|
|
|
|
|
|
cmp |
33
|
|
|
|
|
|
|
eq |
34
|
|
|
|
|
|
|
gt |
35
|
|
|
|
|
|
|
lt |
36
|
|
|
|
|
|
|
ne |
37
|
|
|
|
|
|
|
not |
38
|
|
|
|
|
|
|
or |
39
|
|
|
|
|
|
|
xor |
40
|
|
|
|
|
|
|
|| |
41
|
|
|
|
|
|
|
||= |
42
|
|
|
|
|
|
|
~~ |
43
|
|
|
|
|
|
|
); |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
Readonly::Array our @DEFAULT_LOGIC_KEYWORDS => qw( |
46
|
|
|
|
|
|
|
else |
47
|
|
|
|
|
|
|
elsif |
48
|
|
|
|
|
|
|
for |
49
|
|
|
|
|
|
|
foreach |
50
|
|
|
|
|
|
|
goto |
51
|
|
|
|
|
|
|
grep |
52
|
|
|
|
|
|
|
if |
53
|
|
|
|
|
|
|
last |
54
|
|
|
|
|
|
|
map |
55
|
|
|
|
|
|
|
next |
56
|
|
|
|
|
|
|
unless |
57
|
|
|
|
|
|
|
until |
58
|
|
|
|
|
|
|
while |
59
|
|
|
|
|
|
|
); |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
Readonly::Array our @DEFAULT_METHOD_MODIFIERS => qw( |
62
|
|
|
|
|
|
|
before |
63
|
|
|
|
|
|
|
after |
64
|
|
|
|
|
|
|
around |
65
|
|
|
|
|
|
|
); |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
Readonly::Scalar my $LAST_CHARACTER => -1; |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
our (@LOGIC_KEYWORDS, @LOGIC_OPERATORS, @METHOD_MODIFIERS); # For user-supplied values; |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
our (%LOGIC_KEYWORDS, %LOGIC_OPERATORS, %METHOD_MODIFIERS); # Populated in _init() |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
# Private instance variables: |
75
|
|
|
|
|
|
|
my %_PATH = (); |
76
|
|
|
|
|
|
|
my %_MAIN_STATS = (); |
77
|
|
|
|
|
|
|
my %_SUBS = (); |
78
|
|
|
|
|
|
|
my %_PACKAGES = (); |
79
|
|
|
|
|
|
|
my %_LINES = (); |
80
|
|
|
|
|
|
|
my %_LOGIC_KEYWORDS = (); |
81
|
|
|
|
|
|
|
my %_LOGIC_OPERATORS = (); |
82
|
|
|
|
|
|
|
my %_METHOD_MODIFIERS = (); |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
sub new { |
85
|
36
|
|
|
36
|
1
|
6740
|
my ( $class, %parameters ) = @_; |
86
|
36
|
|
|
|
|
102
|
my $self = {}; |
87
|
36
|
|
|
|
|
131
|
bless $self, $class; |
88
|
36
|
|
|
|
|
204
|
$self->_init(%parameters); |
89
|
36
|
|
|
|
|
21211
|
return $self; |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
sub _init { |
93
|
36
|
|
|
36
|
|
131
|
my ( $self, %parameters ) = @_; |
94
|
36
|
|
|
|
|
150
|
$_PATH{$self} = $parameters{'path'}; |
95
|
|
|
|
|
|
|
|
96
|
36
|
|
|
|
|
144
|
my $path = $self->path(); |
97
|
|
|
|
|
|
|
|
98
|
36
|
|
|
|
|
70
|
my $document; |
99
|
36
|
100
|
|
|
|
117
|
if (ref $path) { |
100
|
4
|
50
|
|
|
|
18
|
if (ref $path eq 'SCALAR') { |
101
|
4
|
|
|
|
|
39
|
$document = PPI::Document->new($path); |
102
|
|
|
|
|
|
|
} else { |
103
|
0
|
|
|
|
|
0
|
$document = $path; |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
} else { |
106
|
32
|
50
|
|
|
|
1401
|
if ( !-r $path ) { |
107
|
0
|
|
|
|
|
0
|
Carp::confess "Path '$path' is missing or not readable!"; |
108
|
|
|
|
|
|
|
} |
109
|
32
|
|
|
|
|
153
|
$document = _create_ppi_document($path); |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
36
|
100
|
|
|
|
49964
|
my @logic_keywords = @LOGIC_KEYWORDS ? @LOGIC_KEYWORDS : @DEFAULT_LOGIC_KEYWORDS; |
113
|
36
|
|
|
|
|
1912
|
%LOGIC_KEYWORDS = hashify(@logic_keywords); |
114
|
36
|
|
|
|
|
183
|
$_LOGIC_OPERATORS{$self} = \%LOGIC_KEYWORDS; |
115
|
|
|
|
|
|
|
|
116
|
36
|
100
|
|
|
|
196
|
my @logic_operators = @LOGIC_OPERATORS ? @LOGIC_OPERATORS : @DEFAULT_LOGIC_OPERATORS; |
117
|
36
|
|
|
|
|
2920
|
%LOGIC_OPERATORS = hashify(@logic_operators); |
118
|
36
|
|
|
|
|
129
|
$_LOGIC_OPERATORS{$self} = \%LOGIC_OPERATORS; |
119
|
|
|
|
|
|
|
|
120
|
36
|
50
|
|
|
|
159
|
my @method_modifiers = @METHOD_MODIFIERS ? @METHOD_MODIFIERS : @DEFAULT_METHOD_MODIFIERS; |
121
|
36
|
|
|
|
|
586
|
%METHOD_MODIFIERS = hashify(@method_modifiers); |
122
|
36
|
|
|
|
|
108
|
$_METHOD_MODIFIERS{$self} = \%METHOD_MODIFIERS; |
123
|
|
|
|
|
|
|
|
124
|
36
|
|
|
|
|
137
|
$document = $self->_make_pruned_document($document); |
125
|
|
|
|
|
|
|
|
126
|
36
|
50
|
|
|
|
126
|
if ( !defined $document ) { |
127
|
0
|
|
|
|
|
0
|
cluck "Could not make a PPI document from '$path'"; |
128
|
0
|
|
|
|
|
0
|
return; |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
|
131
|
36
|
|
|
|
|
150
|
my $packages = _get_packages($document); |
132
|
|
|
|
|
|
|
|
133
|
36
|
|
|
|
|
100
|
my @sub_analysis = (); |
134
|
36
|
|
|
|
|
121
|
my $sub_elements = $document->find('PPI::Statement::Sub'); |
135
|
36
|
|
|
|
|
74488
|
@sub_analysis = @{ $self->_iterate_over_subs($sub_elements) }; |
|
36
|
|
|
|
|
160
|
|
136
|
|
|
|
|
|
|
|
137
|
36
|
|
|
|
|
176
|
$_MAIN_STATS{$self} |
138
|
|
|
|
|
|
|
= $self->analyze_main( $document, $sub_elements, \@sub_analysis ); |
139
|
36
|
|
|
|
|
10580
|
$_SUBS{$self} = \@sub_analysis; |
140
|
36
|
|
|
|
|
98
|
$_PACKAGES{$self} = $packages; |
141
|
36
|
|
|
|
|
127
|
$_LINES{$self} = $self->get_node_length($document); |
142
|
|
|
|
|
|
|
|
143
|
36
|
|
|
|
|
455
|
return $self; |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
sub _create_ppi_document { |
147
|
32
|
|
|
32
|
|
98
|
my $path = shift; |
148
|
32
|
|
|
|
|
63
|
my $document; |
149
|
32
|
100
|
|
|
|
414
|
if ( -s $path ) { |
150
|
29
|
|
|
|
|
276
|
$document = PPI::Document->new($path); |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
else { |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
# The file is empty. Create a PPI document with a single whitespace |
155
|
|
|
|
|
|
|
# chararacter. This makes sure that the PPI tokens() method |
156
|
|
|
|
|
|
|
# returns something, so we avoid a warning from |
157
|
|
|
|
|
|
|
# PPI::Document::index_locations() which expects tokens() to return |
158
|
|
|
|
|
|
|
# something other than undef. |
159
|
3
|
|
|
|
|
10
|
my $one_whitespace_character = q{ }; |
160
|
3
|
|
|
|
|
29
|
$document = PPI::Document->new( \$one_whitespace_character ); |
161
|
|
|
|
|
|
|
} |
162
|
32
|
|
|
|
|
321612
|
return $document; |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
sub _make_pruned_document { |
166
|
36
|
|
|
36
|
|
97
|
my ($self, $document) = @_; |
167
|
36
|
|
|
|
|
115
|
$document = _prune_non_code_lines($document); |
168
|
36
|
|
|
|
|
180
|
$document = $self->_rewrite_moose_method_modifiers($document); |
169
|
36
|
|
|
|
|
281
|
$document->index_locations(); |
170
|
36
|
|
|
|
|
75232
|
$document->readonly(1); |
171
|
36
|
|
|
|
|
157
|
return $document; |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
sub all_counts { |
175
|
5
|
|
|
5
|
1
|
30
|
my $self = shift; |
176
|
5
|
|
|
|
|
19
|
my $stats_hash = { |
177
|
|
|
|
|
|
|
path => $self->path, |
178
|
|
|
|
|
|
|
lines => $self->lines, |
179
|
|
|
|
|
|
|
main_stats => $self->main_stats, |
180
|
|
|
|
|
|
|
subs => $self->subs, |
181
|
|
|
|
|
|
|
packages => $self->packages, |
182
|
|
|
|
|
|
|
}; |
183
|
5
|
|
|
|
|
40
|
return $stats_hash; |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
sub analyze_main { |
187
|
36
|
|
|
36
|
1
|
69
|
my $self = shift; |
188
|
36
|
|
|
|
|
64
|
my $document = shift; |
189
|
36
|
|
|
|
|
76
|
my $sub_elements = shift; |
190
|
36
|
|
|
|
|
67
|
my $sub_analysis = shift; |
191
|
|
|
|
|
|
|
|
192
|
36
|
50
|
|
|
|
152
|
if ( !$document->isa('PPI::Document') ) { |
193
|
0
|
|
|
|
|
0
|
Carp::confess('Did not supply a PPI::Document'); |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
|
196
|
36
|
|
|
|
|
119
|
my $lines = $self->get_node_length($document); |
197
|
36
|
|
|
|
|
66
|
foreach my $sub ( @{$sub_analysis} ) { |
|
36
|
|
|
|
|
107
|
|
198
|
38
|
|
|
|
|
90
|
$lines -= $sub->{lines}; |
199
|
|
|
|
|
|
|
} |
200
|
36
|
|
|
|
|
158
|
my $document_without_subs = $document->clone; |
201
|
36
|
|
|
|
|
47804
|
$document_without_subs->prune('PPI::Statement::Sub'); |
202
|
36
|
|
|
|
|
51764
|
my $complexity = $self->measure_complexity($document_without_subs); |
203
|
36
|
|
|
|
|
183
|
my $results = { |
204
|
|
|
|
|
|
|
name => '{code not in named subroutines}', |
205
|
|
|
|
|
|
|
lines => $lines, |
206
|
|
|
|
|
|
|
mccabe_complexity => $complexity, |
207
|
|
|
|
|
|
|
path => $self->path, |
208
|
|
|
|
|
|
|
}; |
209
|
36
|
|
|
|
|
195
|
return $results; |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
sub get_node_length { |
213
|
193
|
|
|
193
|
1
|
6680
|
my ( $self, $node ) = @_; |
214
|
193
|
|
|
|
|
304
|
my $eval_result = eval { $node = _prune_non_code_lines($node); }; |
|
193
|
|
|
|
|
468
|
|
215
|
193
|
50
|
|
|
|
838
|
return 0 if not $eval_result; |
216
|
193
|
50
|
|
|
|
518
|
return 0 if ( !defined $node ); |
217
|
193
|
|
|
|
|
655
|
my $string = $node->content; |
218
|
193
|
100
|
|
|
|
42533
|
return 0 if ( !length $string ); |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
# Replace whitespace-newline with newline |
221
|
191
|
|
|
|
|
2549
|
$string =~ s/ \s+ \Q$INPUT_RECORD_SEPARATOR\E /$INPUT_RECORD_SEPARATOR/smxg; |
222
|
191
|
|
|
|
|
1484
|
$string =~ s/\Q$INPUT_RECORD_SEPARATOR\E /$INPUT_RECORD_SEPARATOR/smxg; |
223
|
191
|
|
|
|
|
719
|
$string =~ s/ \A \s+ //msx; # Remove leading whitespace |
224
|
191
|
|
|
|
|
1583
|
my @newlines = ( $string =~ /$ALL_NEWLINES_REGEX/smxg ); |
225
|
191
|
|
|
|
|
394
|
my $line_count = scalar @newlines; |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
# if the string is not empty and the last character is not a newline then add 1 |
228
|
191
|
100
|
|
|
|
514
|
if ( length $string ) { |
229
|
182
|
|
|
|
|
480
|
my $last_char = substr $string, $LAST_CHARACTER, 1; |
230
|
182
|
100
|
|
|
|
606
|
if ( $last_char ne "$INPUT_RECORD_SEPARATOR" ) { |
231
|
79
|
|
|
|
|
132
|
$line_count++; |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
|
235
|
191
|
|
|
|
|
813
|
return $line_count; |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
sub path { |
239
|
161
|
|
|
161
|
1
|
366
|
my ($self) = @_; |
240
|
161
|
|
|
|
|
812
|
return $_PATH{$self}; |
241
|
|
|
|
|
|
|
} |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
sub main_stats { |
244
|
74
|
|
|
74
|
1
|
108
|
my ($self) = @_; |
245
|
74
|
|
|
|
|
181
|
return $_MAIN_STATS{$self}; |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
sub subs { |
249
|
32
|
|
|
32
|
1
|
50
|
my ($self) = @_; |
250
|
32
|
|
|
|
|
111
|
return $_SUBS{$self}; |
251
|
|
|
|
|
|
|
} |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
sub packages { |
254
|
32
|
|
|
32
|
1
|
68
|
my ($self) = @_; |
255
|
32
|
|
|
|
|
123
|
return $_PACKAGES{$self}; |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
sub lines { |
259
|
28
|
|
|
28
|
1
|
53
|
my ($self) = @_; |
260
|
28
|
|
|
|
|
70
|
return $_LINES{$self}; |
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
sub logic_keywords { |
264
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
265
|
0
|
0
|
|
|
|
0
|
return wantarray ? @{$_LOGIC_KEYWORDS{$self}} : $_LOGIC_KEYWORDS{$self}; |
|
0
|
|
|
|
|
0
|
|
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
sub logic_operators { |
269
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
270
|
0
|
0
|
|
|
|
0
|
return wantarray ? @{$_LOGIC_OPERATORS{$self}} : $_LOGIC_OPERATORS{$self}; |
|
0
|
|
|
|
|
0
|
|
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
sub method_modifiers { |
274
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
275
|
0
|
0
|
|
|
|
0
|
return wantarray ? @{$_METHOD_MODIFIERS{$self}} : $_METHOD_MODIFIERS{$self}; |
|
0
|
|
|
|
|
0
|
|
276
|
0
|
|
|
|
|
0
|
1} |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
sub measure_complexity { |
279
|
81
|
|
|
81
|
1
|
15019
|
my $self = shift; |
280
|
81
|
|
|
|
|
162
|
my $elem = shift; |
281
|
|
|
|
|
|
|
|
282
|
81
|
|
|
|
|
161
|
my $complexity_count = 0; |
283
|
81
|
100
|
|
|
|
242
|
if ( $self->get_node_length($elem) == 0 ) { |
284
|
5
|
|
|
|
|
15
|
return $complexity_count; |
285
|
|
|
|
|
|
|
} |
286
|
|
|
|
|
|
|
|
287
|
76
|
50
|
|
|
|
302
|
if ($elem) { |
288
|
76
|
|
|
|
|
171
|
$complexity_count++; |
289
|
|
|
|
|
|
|
} |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
# Count up all the logic keywords, weed out hash keys |
292
|
76
|
|
50
|
|
|
314
|
my $keywords_ref = $elem->find('PPI::Token::Word') || []; |
293
|
76
|
|
|
|
|
83459
|
my @filtered = grep { !is_hash_key($_) } @{$keywords_ref}; |
|
607
|
|
|
|
|
1284
|
|
|
76
|
|
|
|
|
199
|
|
294
|
76
|
|
|
|
|
185
|
$complexity_count += grep { exists $LOGIC_KEYWORDS{$_} } @filtered; |
|
589
|
|
|
|
|
2034
|
|
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
# Count up all the logic operators |
297
|
76
|
|
|
|
|
466
|
my $operators_ref = $elem->find('PPI::Token::Operator'); |
298
|
76
|
100
|
|
|
|
82735
|
if ($operators_ref) { |
299
|
|
|
|
|
|
|
$complexity_count |
300
|
42
|
|
|
|
|
111
|
+= grep { exists $LOGIC_OPERATORS{$_} } @{$operators_ref}; |
|
152
|
|
|
|
|
613
|
|
|
42
|
|
|
|
|
112
|
|
301
|
|
|
|
|
|
|
} |
302
|
76
|
|
|
|
|
644
|
return $complexity_count; |
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
sub _get_packages { |
306
|
36
|
|
|
36
|
|
85
|
my $document = shift; |
307
|
|
|
|
|
|
|
|
308
|
36
|
|
|
|
|
84
|
my @unique_packages = (); |
309
|
36
|
|
|
|
|
158
|
my $found_packages = $document->find('PPI::Statement::Package'); |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
return \@unique_packages |
312
|
36
|
100
|
|
|
|
76473
|
if ( |
313
|
|
|
|
|
|
|
!Perl::Metrics::Simple::Analysis::is_ref( $found_packages, 'ARRAY' ) ); |
314
|
|
|
|
|
|
|
|
315
|
17
|
|
|
|
|
50
|
my %seen_packages = (); |
316
|
|
|
|
|
|
|
|
317
|
17
|
|
|
|
|
33
|
foreach my $package ( @{$found_packages} ) { |
|
17
|
|
|
|
|
54
|
|
318
|
29
|
|
|
|
|
437
|
$seen_packages{ $package->namespace() }++; |
319
|
|
|
|
|
|
|
} |
320
|
|
|
|
|
|
|
|
321
|
17
|
|
|
|
|
562
|
@unique_packages = sort keys %seen_packages; |
322
|
|
|
|
|
|
|
|
323
|
17
|
|
|
|
|
77
|
return \@unique_packages; |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
sub _iterate_over_subs { |
327
|
36
|
|
|
36
|
|
71
|
my $self = shift; |
328
|
36
|
|
|
|
|
70
|
my $found_subs = shift; |
329
|
|
|
|
|
|
|
|
330
|
36
|
100
|
|
|
|
136
|
return [] |
331
|
|
|
|
|
|
|
if ( !Perl::Metrics::Simple::Analysis::is_ref( $found_subs, 'ARRAY' ) ); |
332
|
|
|
|
|
|
|
|
333
|
16
|
|
|
|
|
46
|
my @subs = (); |
334
|
|
|
|
|
|
|
|
335
|
16
|
|
|
|
|
37
|
foreach my $sub ( @{$found_subs} ) { |
|
16
|
|
|
|
|
57
|
|
336
|
38
|
|
|
|
|
146
|
my $sub_length = $self->get_node_length($sub); |
337
|
38
|
|
|
|
|
159
|
push @subs, |
338
|
|
|
|
|
|
|
{ |
339
|
|
|
|
|
|
|
path => $self->path, |
340
|
|
|
|
|
|
|
name => $sub->name, |
341
|
|
|
|
|
|
|
lines => $sub_length, |
342
|
|
|
|
|
|
|
mccabe_complexity => $self->measure_complexity($sub), |
343
|
|
|
|
|
|
|
}; |
344
|
|
|
|
|
|
|
} |
345
|
16
|
|
|
|
|
76
|
return \@subs; |
346
|
|
|
|
|
|
|
} |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
#------------------------------------------------------------------------- |
349
|
|
|
|
|
|
|
# Copied from |
350
|
|
|
|
|
|
|
# http://search.cpan.org/src/THALJEF/Perl-Critic-0.19/lib/Perl/Critic/Utils.pm |
351
|
|
|
|
|
|
|
sub hashify { |
352
|
108
|
|
|
108
|
1
|
325
|
my @hash_keys = @_; |
353
|
108
|
|
|
|
|
188
|
return map { $_ => 1 } @hash_keys; |
|
1479
|
|
|
|
|
2859
|
|
354
|
|
|
|
|
|
|
} |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
#------------------------------------------------------------------------- |
357
|
|
|
|
|
|
|
# Copied and somehwat simplified from |
358
|
|
|
|
|
|
|
# http://search.cpan.org/src/THALJEF/Perl-Critic-0.19/lib/Perl/Critic/Utils.pm |
359
|
|
|
|
|
|
|
sub is_hash_key { |
360
|
612
|
|
|
612
|
1
|
10374
|
my $ppi_elem = shift; |
361
|
|
|
|
|
|
|
|
362
|
612
|
|
|
|
|
783
|
my $is_hash_key = eval { |
363
|
612
|
|
|
|
|
1275
|
my $parent = $ppi_elem->parent(); |
364
|
612
|
|
|
|
|
2617
|
my $grandparent = $parent->parent(); |
365
|
612
|
100
|
|
|
|
2730
|
if ( $grandparent->isa('PPI::Structure::Subscript') ) { |
366
|
14
|
|
|
|
|
31
|
return 1; |
367
|
|
|
|
|
|
|
} |
368
|
598
|
|
|
|
|
1226
|
my $sib = $ppi_elem->snext_sibling(); |
369
|
598
|
100
|
100
|
|
|
13159
|
if ( $sib->isa('PPI::Token::Operator') && $sib eq '=>' ) { |
370
|
6
|
|
|
|
|
128
|
return 1; |
371
|
|
|
|
|
|
|
} |
372
|
590
|
|
|
|
|
1436
|
return; |
373
|
|
|
|
|
|
|
}; |
374
|
|
|
|
|
|
|
|
375
|
612
|
|
|
|
|
1323
|
return $is_hash_key; |
376
|
|
|
|
|
|
|
} |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
sub _prune_non_code_lines { |
379
|
229
|
|
|
229
|
|
445
|
my $document = shift; |
380
|
229
|
50
|
|
|
|
667
|
if ( !defined $document ) { |
381
|
0
|
|
|
|
|
0
|
Carp::confess('Did not supply a document!'); |
382
|
|
|
|
|
|
|
} |
383
|
229
|
|
|
|
|
850
|
$document->prune('PPI::Token::Comment'); |
384
|
229
|
|
|
|
|
345055
|
$document->prune('PPI::Token::Pod'); |
385
|
229
|
|
|
|
|
329325
|
$document->prune('PPI::Token::End'); |
386
|
|
|
|
|
|
|
|
387
|
229
|
|
|
|
|
329674
|
return $document; |
388
|
|
|
|
|
|
|
} |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
sub _rewrite_moose_method_modifiers { |
391
|
36
|
|
|
36
|
|
103
|
my ($self, $document) = @_; |
392
|
36
|
50
|
|
|
|
157
|
if ( !defined $document ) { |
393
|
0
|
|
|
|
|
0
|
Carp::confess('Did not supply a document!'); |
394
|
|
|
|
|
|
|
} |
395
|
|
|
|
|
|
|
|
396
|
36
|
|
|
|
|
76
|
my $re = '^(' . join('|', map {quotemeta} keys %{$_METHOD_MODIFIERS{$self}}) . ')$'; |
|
108
|
|
|
|
|
359
|
|
|
36
|
|
|
|
|
225
|
|
397
|
|
|
|
|
|
|
my @method_modifiers = |
398
|
|
|
|
|
|
|
# 5th child: { ... } |
399
|
3
|
|
|
|
|
27
|
grep { $_->[5]->isa('PPI::Structure::Block') } |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
# 4th child: sub |
402
|
|
|
|
|
|
|
grep { |
403
|
3
|
50
|
|
|
|
31
|
$_->[4]->isa('PPI::Token::Word') |
404
|
|
|
|
|
|
|
&& $_->[4]->content eq 'sub' |
405
|
|
|
|
|
|
|
} |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
# 3rd child: => |
408
|
|
|
|
|
|
|
grep { |
409
|
3
|
50
|
|
|
|
24
|
$_->[3]->isa('PPI::Token::Operator') |
410
|
|
|
|
|
|
|
&& $_->[3]->content eq '=>' |
411
|
|
|
|
|
|
|
} |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
# 2nd child: 'method_name' |
414
|
3
|
50
|
|
|
|
20
|
grep { $_->[2]->isa('PPI::Token::Quote') |
415
|
|
|
|
|
|
|
|| $_->[2]->isa('PPI::Token::Word') } |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
# 1st child: after |
418
|
|
|
|
|
|
|
grep { |
419
|
65
|
100
|
|
|
|
1441
|
$_->[1]->isa('PPI::Token::Word') |
420
|
|
|
|
|
|
|
&& $_->[1]->content =~ /$re/ |
421
|
|
|
|
|
|
|
} |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
# create an arrayref [item, child0, child1, child2] |
424
|
|
|
|
|
|
|
# for easier, cheaper access |
425
|
65
|
|
|
|
|
542
|
map { [ $_, $_->schildren ] } |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
# don't want subclasses of PPI::Statement here |
428
|
36
|
|
|
|
|
200
|
grep { $_->class eq 'PPI::Statement' } $document->schildren; |
|
210
|
|
|
|
|
1612
|
|
429
|
|
|
|
|
|
|
|
430
|
36
|
|
|
|
|
484
|
for (@method_modifiers) { |
431
|
3
|
|
|
|
|
11
|
my ($old_stmt, @children) = @$_; |
432
|
3
|
|
|
|
|
19
|
my $name = '_' . $children[0]->literal . '_' . $children[1]->literal; |
433
|
3
|
|
|
|
|
101
|
my $new_stmt = PPI::Statement::Sub->new(); |
434
|
3
|
|
|
|
|
68
|
$new_stmt->add_element(PPI::Token::Word->new('sub')); |
435
|
3
|
|
|
|
|
162
|
$new_stmt->add_element(PPI::Token::Whitespace->new(' ')); |
436
|
3
|
|
|
|
|
53
|
$new_stmt->add_element(PPI::Token::Word->new($name)); |
437
|
3
|
|
|
|
|
48
|
$new_stmt->add_element(PPI::Token::Whitespace->new(' ')); |
438
|
3
|
|
|
|
|
88
|
$new_stmt->add_element($children[4]->clone()); |
439
|
|
|
|
|
|
|
|
440
|
3
|
|
|
|
|
485
|
$old_stmt->insert_after($new_stmt); |
441
|
3
|
|
|
|
|
228
|
$old_stmt->delete(); |
442
|
|
|
|
|
|
|
} |
443
|
|
|
|
|
|
|
|
444
|
36
|
|
|
|
|
534
|
return $document; |
445
|
|
|
|
|
|
|
} |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
1; |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
__END__ |