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