Login
RT #79289: False Postive in Perl::Critic::Utils::is_in_void_context()
[gknop/Perl-Critic.git] / examples / generatestats
1 #!/usr/bin/perl
2
3 ##############################################################################
4 #      $URL$
5 #     $Date$
6 #   $Author$
7 # $Revision$
8 ##############################################################################
9
10 use 5.008001;
11 use strict;
12 use warnings;
13
14 use version; our $VERSION = qv('1.116');
15
16 use Carp qw{ croak };
17 use English qw{ -no_match_vars };
18 use Readonly;
19
20 use File::Spec qw{ };
21 use Perl6::Say;
22
23 use Perl::Critic::Utils qw{ all_perl_files };
24 use Perl::Critic;
25
26
27 if ( ! @ARGV ) {
28     die qq{usage: generatestats path [...]\n};
29 }
30
31 main();
32
33 exit 0;
34
35
36 sub main {
37     foreach my $path ( @ARGV ) {
38         say "Looking at $path.";
39
40         my @files = all_perl_files($path);
41         say 'Analyzing ', scalar @files, ' files.';
42
43         my $results = summarize( \@files, File::Spec->canonpath($path) );
44
45         report($results);
46
47         say; say;
48     }
49
50     return;
51 }
52
53
54 sub summarize {
55     my ( $files, $path ) = @_;
56
57     # Force reporting level to be really strict, just so that the statistics
58     # include everything.
59     my $critic = Perl::Critic->new( -severity => 1 );
60
61     my %total_severities;
62     my %total_policies;
63     my %types;
64     my %files;
65
66     foreach my $file ( @{$files} ) {
67         my $relative_path;
68         my $type;
69
70         if ($file eq $path) {
71             $relative_path = $file;
72         } else {
73             my $absolute_path_length = ( length $path ) + 1;
74
75             $relative_path = substr $file, $absolute_path_length;
76         }
77
78         if ($file =~ m/ [.] ([^.]+) \z /xms) {
79             $type = $1;
80         } else {
81             $type = '<program>';
82         }
83
84         $types{$type}{files}++;
85         foreach my $violation ( $critic->critique($file) ) {
86             $files{ $relative_path }{ severities }{ $violation->severity() }++;
87             $files{ $relative_path }{ policies   }{ $violation->policy()   }++;
88
89             $types{ $type          }{ severities }{ $violation->severity() }++;
90             $types{ $type          }{ policies   }{ $violation->policy()   }++;
91
92             $total_severities{ $violation->severity() }++;
93             $total_policies{   $violation->policy()   }++;
94         }
95     }
96
97     return {
98         severities  => \%total_severities,
99         policies    => \%total_policies,
100         types       => \%types,
101         files       => \%files,
102     };
103 }
104
105
106 sub report {
107     my ( $results ) = @_;
108
109     report_totals( $results );
110     report_types(  $results );
111     report_files(  $results );
112
113     return;
114 }
115
116
117 sub report_totals {
118     my ( $results ) = @_;
119
120     say;
121     say 'Total violations by severity:';
122     report_severities( $results->{severities} );
123
124     say;
125     say 'Total violations by policy:';
126     report_policies( $results->{policies} );
127
128     return;
129 }
130
131
132 sub report_types {
133     my ( $results ) = @_;
134     my   $types     = $results->{types};
135
136     say;
137     say 'Total files by type:';
138     foreach my $type ( sort keys %{$types} ) {
139         say qq{\t}, $type, ': ', $types->{$type}{files};
140     }
141
142     foreach my $type ( sort keys %{$types} ) {
143         say;
144         say "Violations in $type files by severity:";
145         report_severities( $types->{$type}{severities} );
146
147         say;
148         say "Violations in $type files by policy:";
149         report_policies( $types->{$type}{policies} );
150     }
151
152     return;
153 }
154
155
156 sub report_files {
157     my ( $results ) = @_;
158     my   $files     = $results->{files};
159
160     foreach my $file ( sort keys %{$files} ) {
161         say;
162         say "Violations in $file by severity:";
163         report_severities( $files->{$file}{severities} );
164
165         say;
166         say "Violations in $file by policy:";
167         report_policies( $files->{$file}{policies} );
168     }
169
170     return;
171 }
172
173
174 sub report_severities {
175     my ($severities) = @_;
176
177     foreach my $severity ( reverse sort { $a <=> $b } keys %{$severities} ) {
178         say qq{\t}, $severity, ': ', $severities->{$severity};
179     }
180
181     return;
182 }
183
184
185 sub report_policies {
186     my ($policies) = @_;
187
188     foreach my $policy ( sort keys %{$policies} ) {
189         (my $short_policy = $policy) =~ s/ \A Perl::Critic::Policy:: //xms;
190
191         say qq{\t}, $short_policy, ': ', $policies->{$policy};
192     }
193
194     return;
195 }
196
197
198 __END__
199
200 =pod
201
202 =for stopwords codebase perlartistic
203
204 =head1 NAME
205
206 C<generatestats> - Produce some simple quality statistics of a codebase
207
208
209 =head1 USAGE
210
211     generatestats path [...]
212
213
214 =head1 DESCRIPTION
215
216 Scan a body of code and generate some statistics on violations of the
217 installed L<Perl::Critic|Perl::Critic> policies.  While there is no means of
218 configuring the policies here, this will take into account your
219 F<.perlcriticrc>, if available.
220
221
222 =head1 REQUIRED ARGUMENTS
223
224 A list of paths to files and directories to find code in.
225
226
227 =head1 OPTIONS
228
229 None.
230
231
232 =head1 DIAGNOSTICS
233
234 None.
235
236
237 =head1 EXIT STATUS
238
239 0
240
241
242 =head1 CONFIGURATION
243
244 None.
245
246
247 =head1 DEPENDENCIES
248
249 L<Perl::Critic|Perl::Critic>
250 L<Perl6::Say|Perl6::Say>
251 L<Readonly|Readonly>
252
253
254 =head1 INCOMPATIBILITIES
255
256 None reported.
257
258
259 =head1 BUGS AND LIMITATIONS
260
261 This is an example program and thus does minimal error handling.
262
263
264 =head1 AUTHOR
265
266 Elliot Shank  C<< <perl@galumph.com> >>
267
268
269 =head1 COPYRIGHT
270
271 Copyright (c) 2006-2011, Elliot Shank.
272
273 This module is free software; you can redistribute it and/or modify it under
274 the same terms as Perl itself. See L<perlartistic|perlartistic>.
275
276
277 =head1 DISCLAIMER OF WARRANTY
278
279 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE
280 SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE
281 STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE
282 SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED,
283 INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
284 FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND
285 PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE,
286 YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION.
287
288 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY
289 COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE
290 SOFTWARE AS PERMITTED BY THE ABOVE LICENSE, BE LIABLE TO YOU FOR DAMAGES,
291 INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING
292 OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO
293 LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR
294 THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER
295 SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
296 POSSIBILITY OF SUCH DAMAGES.
297
298 =cut
299
300 # Local Variables:
301 #   mode: cperl
302 #   cperl-indent-level: 4
303 #   fill-column: 78
304 #   indent-tabs-mode: nil
305 #   c-indentation-style: bsd
306 # End:
307 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :