Login
Now that we have ProhibitUselessNoCritic, we can
[gknop/Perl-Critic.git] / examples / generatestats
CommitLineData
81f23a94
ES
1#!/usr/bin/perl
2
3##############################################################################
4# $URL$
5# $Date$
6# $Author$
7# $Revision$
81f23a94
ES
8##############################################################################
9
daa9dc42 10## no critic (ErrorHandling::RequireUseOfExceptions)
81f23a94
ES
11use 5.008001;
12use strict;
13use warnings;
14
173667ce 15use version; our $VERSION = qv('1.093_001');
81f23a94
ES
16
17use Carp qw{ croak };
18use English qw{ -no_match_vars };
19use Readonly;
20
21use File::Spec qw{ };
22use Perl6::Say;
23
24use Perl::Critic::Utils qw{ all_perl_files };
25use Perl::Critic;
26
27
28if ( ! @ARGV ) {
29 die qq{usage: generatestats path [...]\n};
30}
31
32main();
33
34exit 0;
35
36
37sub 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
55sub 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;
81f23a94
ES
66
67 foreach my $file ( @{$files} ) {
68 my $relative_path;
69 my $type;
81f23a94
ES
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
107sub report {
108 my ( $results ) = @_;
109
110 report_totals( $results );
111 report_types( $results );
112 report_files( $results );
113
114 return;
115}
116
117
118sub 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
133sub 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
157sub 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
175sub 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
186sub 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
27fb3a4e 203=for stopwords codebase perlartistic
ee0fa298 204
81f23a94
ES
205=head1 NAME
206
207C<generatestats> - Produce some simple quality statistics of a codebase
208
209
210=head1 USAGE
211
11f53956 212 generatestats path [...]
81f23a94
ES
213
214
215=head1 DESCRIPTION
216
217Scan a body of code and generate some statistics on violations of the
11f53956
ES
218installed L<Perl::Critic|Perl::Critic> policies. While there is no means of
219configuring the policies here, this will take into account your
220F<.perlcriticrc>, if available.
81f23a94
ES
221
222
223=head1 REQUIRED ARGUMENTS
224
225A list of paths to files and directories to find code in.
226
227
228=head1 OPTIONS
229
230None.
231
232
233=head1 DIAGNOSTICS
234
235None.
236
237
238=head1 EXIT STATUS
239
2400
241
242
243=head1 CONFIGURATION
244
245None.
246
247
248=head1 DEPENDENCIES
249
11f53956
ES
250L<Perl::Critic|Perl::Critic>
251L<Perl6::Say|Perl6::Say>
252L<Readonly|Readonly>
81f23a94
ES
253
254
255=head1 INCOMPATIBILITIES
256
257None reported.
258
259
260=head1 BUGS AND LIMITATIONS
261
262This is an example program and thus does minimal error handling.
263
264
265=head1 AUTHOR
266
267Elliot Shank C<< <perl@galumph.com> >>
268
269
ee0fa298 270=head1 COPYRIGHT
81f23a94
ES
271
272Copyright (c) 2006-2007, Elliot Shank C<< <perl@galumph.com> >>. All rights
273reserved.
274
275This module is free software; you can redistribute it and/or modify it under
11f53956 276the same terms as Perl itself. See L<perlartistic|perlartistic>.
81f23a94
ES
277
278
279=head1 DISCLAIMER OF WARRANTY
280
281BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE
282SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE
283STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE
284SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED,
285INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
286FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND
287PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE,
288YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION.
289
290IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY
291COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE
292SOFTWARE AS PERMITTED BY THE ABOVE LICENSE, BE LIABLE TO YOU FOR DAMAGES,
293INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING
294OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO
295LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR
296THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER
297SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
298POSSIBILITY 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:
96fed375 309# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :