--- /dev/null
+#!/usr/bin/perl
+
+##############################################################################
+# $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/examples/generatestats $
+# $Date: 2008-05-18 23:24:38 -0500 (Sun, 18 May 2008) $
+# $Author: clonezone $
+# $Revision: 2376 $
+##############################################################################
+
+## no critic (ErrorHandling::RequireUseOfExceptions)
+use 5.008001;
+use strict;
+use warnings;
+
+use version; our $VERSION = qv('1.002');
+
+use Carp qw{ croak };
+use English qw{ -no_match_vars };
+use Readonly;
+
+use File::Spec qw{ };
+use Perl6::Say;
+
+use Perl::Critic::Utils qw{ all_perl_files };
+use Perl::Critic;
+
+
+if ( ! @ARGV ) {
+ die qq{usage: generatestats path [...]\n};
+}
+
+main();
+
+exit 0;
+
+
+sub main {
+ foreach my $path ( @ARGV ) {
+ say "Looking at $path.";
+
+ my @files = all_perl_files($path);
+ say 'Analyzing ', scalar @files, ' files.';
+
+ my $results = summarize( \@files, File::Spec->canonpath($path) );
+
+ report($results);
+
+ say; say;
+ }
+
+ return;
+}
+
+
+sub summarize {
+ my ( $files, $path ) = @_;
+
+ # Force reporting level to be really strict, just so that the statistics
+ # include everything.
+ my $critic = Perl::Critic->new( -severity => 1 );
+
+ my %total_severities;
+ my %total_policies;
+ my %types;
+ my %files;
+
+ foreach my $file ( @{$files} ) {
+ my $relative_path;
+ my $type;
+
+ if ($file eq $path) {
+ $relative_path = $file;
+ } else {
+ my $absolute_path_length = ( length $path ) + 1;
+
+ $relative_path = substr $file, $absolute_path_length;
+ }
+
+ if ($file =~ m/ [.] ([^.]+) \z /xms) {
+ $type = $1;
+ } else {
+ $type = '<program>';
+ }
+
+ $types{$type}{files}++;
+ foreach my $violation ( $critic->critique($file) ) {
+ $files{ $relative_path }{ severities }{ $violation->severity() }++;
+ $files{ $relative_path }{ policies }{ $violation->policy() }++;
+
+ $types{ $type }{ severities }{ $violation->severity() }++;
+ $types{ $type }{ policies }{ $violation->policy() }++;
+
+ $total_severities{ $violation->severity() }++;
+ $total_policies{ $violation->policy() }++;
+ }
+ }
+
+ return {
+ severities => \%total_severities,
+ policies => \%total_policies,
+ types => \%types,
+ files => \%files,
+ };
+}
+
+
+sub report {
+ my ( $results ) = @_;
+
+ report_totals( $results );
+ report_types( $results );
+ report_files( $results );
+
+ return;
+}
+
+
+sub report_totals {
+ my ( $results ) = @_;
+
+ say;
+ say 'Total violations by severity:';
+ report_severities( $results->{severities} );
+
+ say;
+ say 'Total violations by policy:';
+ report_policies( $results->{policies} );
+
+ return;
+}
+
+
+sub report_types {
+ my ( $results ) = @_;
+ my $types = $results->{types};
+
+ say;
+ say 'Total files by type:';
+ foreach my $type ( sort keys %{$types} ) {
+ say qq{\t}, $type, ': ', $types->{$type}{files};
+ }
+
+ foreach my $type ( sort keys %{$types} ) {
+ say;
+ say "Violations in $type files by severity:";
+ report_severities( $types->{$type}{severities} );
+
+ say;
+ say "Violations in $type files by policy:";
+ report_policies( $types->{$type}{policies} );
+ }
+
+ return;
+}
+
+
+sub report_files {
+ my ( $results ) = @_;
+ my $files = $results->{files};
+
+ foreach my $file ( sort keys %{$files} ) {
+ say;
+ say "Violations in $file by severity:";
+ report_severities( $files->{$file}{severities} );
+
+ say;
+ say "Violations in $file by policy:";
+ report_policies( $files->{$file}{policies} );
+ }
+
+ return;
+}
+
+
+sub report_severities {
+ my ($severities) = @_;
+
+ foreach my $severity ( reverse sort { $a <=> $b } keys %{$severities} ) {
+ say qq{\t}, $severity, ': ', $severities->{$severity};
+ }
+
+ return;
+}
+
+
+sub report_policies {
+ my ($policies) = @_;
+
+ foreach my $policy ( sort keys %{$policies} ) {
+ (my $short_policy = $policy) =~ s/ \A Perl::Critic::Policy:: //xms;
+
+ say qq{\t}, $short_policy, ': ', $policies->{$policy};
+ }
+
+ return;
+}
+
+
+__END__
+
+=pod
+
+=for stopwords codebase
+
+=head1 NAME
+
+C<generatestats> - Produce some simple quality statistics of a codebase
+
+
+=head1 USAGE
+
+ generatestats path [...]
+
+
+=head1 DESCRIPTION
+
+Scan a body of code and generate some statistics on violations of the
+installed L<Perl::Critic> policies. While there is no means of configuring
+the policies here, this will take into account your F<.perlcriticrc>, if
+available.
+
+
+=head1 REQUIRED ARGUMENTS
+
+A list of paths to files and directories to find code in.
+
+
+=head1 OPTIONS
+
+None.
+
+
+=head1 DIAGNOSTICS
+
+None.
+
+
+=head1 EXIT STATUS
+
+0
+
+
+=head1 CONFIGURATION
+
+None.
+
+
+=head1 DEPENDENCIES
+
+L<Perl::Critic>
+L<Perl6::Say>
+L<Readonly>
+
+
+=head1 INCOMPATIBILITIES
+
+None reported.
+
+
+=head1 BUGS AND LIMITATIONS
+
+This is an example program and thus does minimal error handling.
+
+
+=head1 AUTHOR
+
+Elliot Shank C<< <perl@galumph.com> >>
+
+
+=head1 COPYRIGHT
+
+Copyright (c) 2006-2007, Elliot Shank C<< <perl@galumph.com> >>. All rights
+reserved.
+
+This module is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself. See L<perlartistic>.
+
+
+=head1 DISCLAIMER OF WARRANTY
+
+BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE
+SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE
+STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE
+SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND
+PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE,
+YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION.
+
+IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY
+COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE
+SOFTWARE AS PERMITTED BY THE ABOVE LICENSE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO
+LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR
+THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER
+SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+=cut
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 78
+# indent-tabs-mode: nil
+# c-indentation-style: bsd
+# End:
+# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
projects / dh-make-perl / blobdiff