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