File Coverage

blib/lib/Perl/Critic/Statistics.pm
Criterion Covered Total %
statement 88 102 86.2
branch 20 24 83.3
condition 3 3 100.0
subroutine 18 25 72.0
pod 19 19 100.0
total 148 173 85.5


line stmt bran cond sub pod time code
1             package Perl::Critic::Statistics;
2              
3 40     40   1259 use 5.010001;
  40         178  
4 40     40   276 use strict;
  40         122  
  40         902  
5 40     40   258 use warnings;
  40         111  
  40         1309  
6              
7 40     40   302 use English qw(-no_match_vars);
  40         130  
  40         296  
8              
9 40     40   16127 use Perl::Critic::Utils::McCabe qw{ calculate_mccabe_of_sub };
  40         140  
  40         49389  
10              
11             #-----------------------------------------------------------------------------
12              
13             our $VERSION = '1.146';
14              
15             #-----------------------------------------------------------------------------
16              
17             sub new {
18 2730     2730 1 6854 my ( $class ) = @_;
19              
20 2730         6718 my $self = bless {}, $class;
21              
22 2730         6761 $self->{_modules} = 0;
23 2730         5576 $self->{_subs} = 0;
24 2730         5197 $self->{_statements} = 0;
25 2730         4820 $self->{_lines} = 0;
26 2730         5739 $self->{_lines_of_blank} = 0;
27 2730         4903 $self->{_lines_of_comment} = 0;
28 2730         5183 $self->{_lines_of_data} = 0;
29 2730         7665 $self->{_lines_of_perl} = 0;
30 2730         5138 $self->{_lines_of_pod} = 0;
31 2730         5620 $self->{_violations_by_policy} = {};
32 2730         6137 $self->{_violations_by_severity} = {};
33 2730         5727 $self->{_total_violations} = 0;
34              
35 2730         7575 return $self;
36             }
37              
38             #-----------------------------------------------------------------------------
39              
40             sub accumulate {
41 2724     2724 1 6248 my ($self, $doc, $violations) = @_;
42              
43 2724         5340 $self->{_modules}++;
44              
45 2724         7527 my $subs = $doc->find('PPI::Statement::Sub');
46 2724 100       7670 if ($subs) {
47 440         1129 foreach my $sub ( @{$subs} ) {
  440         1333  
48 636         1504 $self->{_subs}++;
49 636         3107 $self->{_subs_total_mccabe} += calculate_mccabe_of_sub( $sub );
50             }
51             }
52              
53 2724         7295 my $statements = $doc->find('PPI::Statement');
54 2724 100       8989 $self->{_statements} += $statements ? scalar @{$statements} : 0;
  2709         5490  
55              
56             ## no critic (RequireDotMatchAnything, RequireExtendedFormatting, RequireLineBoundaryMatching)
57 2724         21714 my @lines = split /$INPUT_RECORD_SEPARATOR/, $doc->serialize();
58             ## use critic
59 2724         1574562 $self->{_lines} += scalar @lines;
60             {
61 2724         4934 my ( $in_data, $in_pod );
  2724         5373  
62 2724         8417 foreach ( @lines ) {
63 23306 100 100     129624 if ( q{=} eq substr $_, 0, 1 ) { ## no critic (ProhibitCascadingIfElse)
    100          
    100          
    100          
    100          
    100          
64 179         478 $in_pod = not m/ \A \s* =cut \b /smx;
65 179         311 $self->{_lines_of_pod}++;
66             } elsif ( $in_pod ) {
67 291         422 $self->{_lines_of_pod}++;
68             } elsif ( q{__END__} eq $_ || q{__DATA__} eq $_ ) {
69 82         171 $in_data = 1;
70 82         161 $self->{_lines_of_perl}++;
71             } elsif ( $in_data ) {
72 183         309 $self->{_lines_of_data}++;
73             } elsif ( m/ \A \s* \# /smx ) {
74 4168         9298 $self->{_lines_of_comment}++;
75             } elsif ( m/ \A \s* \z /smx ) {
76 6189         12463 $self->{_lines_of_blank}++;
77             } else {
78 12214         21527 $self->{_lines_of_perl}++;
79             }
80             }
81             }
82              
83 2724         4642 foreach my $violation ( @{ $violations } ) {
  2724         6229  
84 3038         8823 $self->{_violations_by_severity}->{ $violation->severity() }++;
85 3038         7414 $self->{_violations_by_policy}->{ $violation->policy() }++;
86 3038         5471 $self->{_total_violations}++;
87             }
88              
89 2724         9092 return;
90             }
91              
92             #-----------------------------------------------------------------------------
93              
94             sub modules {
95 3     3 1 573 my ( $self ) = @_;
96              
97 3         16 return $self->{_modules};
98             }
99              
100             #-----------------------------------------------------------------------------
101              
102             sub subs {
103 5     5 1 571 my ( $self ) = @_;
104              
105 5         25 return $self->{_subs};
106             }
107              
108             #-----------------------------------------------------------------------------
109              
110             sub statements {
111 3     3 1 572 my ( $self ) = @_;
112              
113 3         12 return $self->{_statements};
114             }
115              
116             #-----------------------------------------------------------------------------
117              
118             sub lines {
119 3     3 1 676 my ( $self ) = @_;
120              
121 3         20 return $self->{_lines};
122             }
123              
124             #-----------------------------------------------------------------------------
125              
126             sub lines_of_blank {
127 0     0 1 0 my ( $self ) = @_;
128              
129 0         0 return $self->{_lines_of_blank};
130             }
131              
132             #-----------------------------------------------------------------------------
133              
134             sub lines_of_comment {
135 0     0 1 0 my ( $self ) = @_;
136              
137 0         0 return $self->{_lines_of_comment};
138             }
139              
140             #-----------------------------------------------------------------------------
141              
142             sub lines_of_data {
143 0     0 1 0 my ( $self ) = @_;
144              
145 0         0 return $self->{_lines_of_data};
146             }
147              
148             #-----------------------------------------------------------------------------
149              
150             sub lines_of_perl {
151 0     0 1 0 my ( $self ) = @_;
152              
153 0         0 return $self->{_lines_of_perl};
154             }
155              
156             #-----------------------------------------------------------------------------
157              
158             sub lines_of_pod {
159 0     0 1 0 my ( $self ) = @_;
160              
161 0         0 return $self->{_lines_of_pod};
162             }
163              
164             #-----------------------------------------------------------------------------
165              
166             sub _subs_total_mccabe {
167 1     1   3 my ( $self ) = @_;
168              
169 1         6 return $self->{_subs_total_mccabe};
170             }
171              
172             #-----------------------------------------------------------------------------
173              
174             sub violations_by_severity {
175 0     0 1 0 my ( $self ) = @_;
176              
177 0         0 return $self->{_violations_by_severity};
178             }
179              
180             #-----------------------------------------------------------------------------
181              
182             sub violations_by_policy {
183 0     0 1 0 my ( $self ) = @_;
184              
185 0         0 return $self->{_violations_by_policy};
186             }
187              
188             #-----------------------------------------------------------------------------
189              
190             sub total_violations {
191 4     4 1 586 my ( $self ) = @_;
192              
193 4         20 return $self->{_total_violations};
194             }
195              
196             #-----------------------------------------------------------------------------
197              
198             sub statements_other_than_subs {
199 2     2 1 547 my ( $self ) = @_;
200              
201 2         6 return $self->statements() - $self->subs();
202             }
203              
204             #-----------------------------------------------------------------------------
205              
206             sub average_sub_mccabe {
207 1     1 1 550 my ( $self ) = @_;
208              
209 1 50       7 return if $self->subs() == 0;
210              
211 1         7 return $self->_subs_total_mccabe() / $self->subs();
212             }
213              
214             #-----------------------------------------------------------------------------
215              
216             sub violations_per_file {
217 1     1 1 647 my ( $self ) = @_;
218              
219 1 50       4 return if $self->modules() == 0;
220              
221 1         4 return $self->total_violations() / $self->modules();
222             }
223              
224             #-----------------------------------------------------------------------------
225              
226             sub violations_per_statement {
227 1     1 1 548 my ( $self ) = @_;
228              
229 1         5 my $statements = $self->statements_other_than_subs();
230              
231 1 50       6 return if $statements == 0;
232              
233 1         4 return $self->total_violations() / $statements;
234             }
235              
236             #-----------------------------------------------------------------------------
237              
238             sub violations_per_line_of_code {
239 1     1 1 566 my ( $self ) = @_;
240              
241 1 50       6 return if $self->lines() == 0;
242              
243 1         7 return $self->total_violations() / $self->lines();
244             }
245              
246             #-----------------------------------------------------------------------------
247              
248             1;
249              
250             __END__
251              
252             #-----------------------------------------------------------------------------
253              
254             =pod
255              
256             =for stopwords McCabe
257              
258             =head1 NAME
259              
260             Perl::Critic::Statistics - Compile stats on Perl::Critic violations.
261              
262              
263             =head1 DESCRIPTION
264              
265             This class accumulates statistics on Perl::Critic violations across one or
266             more files. NOTE: This class is experimental and subject to change.
267              
268              
269             =head1 INTERFACE SUPPORT
270              
271             This is considered to be a non-public class. Its interface is subject
272             to change without notice.
273              
274              
275             =head1 METHODS
276              
277             =over
278              
279             =item C<new()>
280              
281             Create a new instance of Perl::Critic::Statistics. No arguments are supported
282             at this time.
283              
284              
285             =item C< accumulate( $doc, \@violations ) >
286              
287             Accumulates statistics about the C<$doc> and the C<@violations> that were
288             found.
289              
290              
291             =item C<modules()>
292              
293             The number of chunks of code (usually files) that have been analyzed.
294              
295              
296             =item C<subs()>
297              
298             The total number of subroutines analyzed by this Critic.
299              
300              
301             =item C<statements()>
302              
303             The total number of statements analyzed by this Critic.
304              
305              
306             =item C<lines()>
307              
308             The total number of lines of code analyzed by this Critic.
309              
310              
311             =item C<lines_of_blank()>
312              
313             The total number of blank lines analyzed by this Critic. This includes only
314             blank lines in code, not POD or data.
315              
316              
317             =item C<lines_of_comment()>
318              
319             The total number of comment lines analyzed by this Critic. This includes only
320             lines whose first non-whitespace character is C<#>.
321              
322              
323             =item C<lines_of_data()>
324              
325             The total number of lines of data section analyzed by this Critic, not
326             counting the C<__END__> or C<__DATA__> line. POD in a data section is counted
327             as POD, not data.
328              
329              
330             =item C<lines_of_perl()>
331              
332             The total number of lines of Perl code analyzed by this Critic. Perl appearing
333             in the data section is not counted.
334              
335              
336             =item C<lines_of_pod()>
337              
338             The total number of lines of POD analyzed by this Critic. Pod occurring in a
339             data section is counted as POD, not as data.
340              
341              
342             =item C<violations_by_severity()>
343              
344             The number of violations of each severity found by this Critic as a
345             reference to a hash keyed by severity.
346              
347              
348             =item C<violations_by_policy()>
349              
350             The number of violations of each policy found by this Critic as a
351             reference to a hash keyed by full policy name.
352              
353              
354             =item C<total_violations()>
355              
356             The total number of violations found by this Critic.
357              
358              
359             =item C<statements_other_than_subs()>
360              
361             The total number of statements minus the number of subroutines.
362             Useful because a subroutine is considered a statement by PPI.
363              
364              
365             =item C<average_sub_mccabe()>
366              
367             The average McCabe score of all scanned subroutines.
368              
369              
370             =item C<violations_per_file()>
371              
372             The total violations divided by the number of modules.
373              
374              
375             =item C<violations_per_statement()>
376              
377             The total violations divided by the number statements minus
378             subroutines.
379              
380              
381             =item C<violations_per_line_of_code()>
382              
383             The total violations divided by the lines of code.
384              
385              
386             =back
387              
388              
389             =head1 AUTHOR
390              
391             Elliot Shank C<< <perl@galumph.com> >>
392              
393              
394             =head1 COPYRIGHT
395              
396             Copyright (c) 2007-2011 Elliot Shank.
397              
398             This program is free software; you can redistribute it and/or modify
399             it under the same terms as Perl itself. The full text of this license
400             can be found in the LICENSE file included with this module.
401              
402             =cut
403              
404             ##############################################################################
405             # Local Variables:
406             # mode: cperl
407             # cperl-indent-level: 4
408             # fill-column: 78
409             # indent-tabs-mode: nil
410             # c-indentation-style: bsd
411             # End:
412             # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :