3 ##############################################################################
4 # $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/examples/generatestats $
5 # $Date: 2008-05-18 23:24:38 -0500 (Sun, 18 May 2008) $
8 ##############################################################################
10 ## no critic (ErrorHandling::RequireUseOfExceptions)
15 use version; our $VERSION = qv('1.002');
18 use English qw{ -no_match_vars };
24 use Perl::Critic::Utils qw{ all_perl_files };
29 die qq{usage: generatestats path [...]\n};
38 foreach my $path ( @ARGV ) {
39 say "Looking at $path.";
41 my @files = all_perl_files($path);
42 say 'Analyzing ', scalar @files, ' files.';
44 my $results = summarize( \@files, File::Spec->canonpath($path) );
56 my ( $files, $path ) = @_;
58 # Force reporting level to be really strict, just so that the statistics
60 my $critic = Perl::Critic->new( -severity => 1 );
67 foreach my $file ( @{$files} ) {
72 $relative_path = $file;
74 my $absolute_path_length = ( length $path ) + 1;
76 $relative_path = substr $file, $absolute_path_length;
79 if ($file =~ m/ [.] ([^.]+) \z /xms) {
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() }++;
90 $types{ $type }{ severities }{ $violation->severity() }++;
91 $types{ $type }{ policies }{ $violation->policy() }++;
93 $total_severities{ $violation->severity() }++;
94 $total_policies{ $violation->policy() }++;
99 severities => \%total_severities,
100 policies => \%total_policies,
108 my ( $results ) = @_;
110 report_totals( $results );
111 report_types( $results );
112 report_files( $results );
119 my ( $results ) = @_;
122 say 'Total violations by severity:';
123 report_severities( $results->{severities} );
126 say 'Total violations by policy:';
127 report_policies( $results->{policies} );
134 my ( $results ) = @_;
135 my $types = $results->{types};
138 say 'Total files by type:';
139 foreach my $type ( sort keys %{$types} ) {
140 say qq{\t}, $type, ': ', $types->{$type}{files};
143 foreach my $type ( sort keys %{$types} ) {
145 say "Violations in $type files by severity:";
146 report_severities( $types->{$type}{severities} );
149 say "Violations in $type files by policy:";
150 report_policies( $types->{$type}{policies} );
158 my ( $results ) = @_;
159 my $files = $results->{files};
161 foreach my $file ( sort keys %{$files} ) {
163 say "Violations in $file by severity:";
164 report_severities( $files->{$file}{severities} );
167 say "Violations in $file by policy:";
168 report_policies( $files->{$file}{policies} );
175 sub report_severities {
176 my ($severities) = @_;
178 foreach my $severity ( reverse sort { $a <=> $b } keys %{$severities} ) {
179 say qq{\t}, $severity, ': ', $severities->{$severity};
186 sub report_policies {
189 foreach my $policy ( sort keys %{$policies} ) {
190 (my $short_policy = $policy) =~ s/ \A Perl::Critic::Policy:: //xms;
192 say qq{\t}, $short_policy, ': ', $policies->{$policy};
203 =for stopwords codebase
207 C<generatestats> - Produce some simple quality statistics of a codebase
212 generatestats path [...]
217 Scan a body of code and generate some statistics on violations of the
218 installed L<Perl::Critic> policies. While there is no means of configuring
219 the policies here, this will take into account your F<.perlcriticrc>, if
223 =head1 REQUIRED ARGUMENTS
225 A list of paths to files and directories to find code in.
255 =head1 INCOMPATIBILITIES
260 =head1 BUGS AND LIMITATIONS
262 This is an example program and thus does minimal error handling.
267 Elliot Shank C<< <perl@galumph.com> >>
272 Copyright (c) 2006-2007, Elliot Shank C<< <perl@galumph.com> >>. All rights
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>.
279 =head1 DISCLAIMER OF WARRANTY
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.
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.
304 # cperl-indent-level: 4
306 # indent-tabs-mode: nil
307 # c-indentation-style: bsd
309 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :