package Perl::Critic::Statistics; use 5.010001; use strict; use warnings; use English qw(-no_match_vars); use Perl::Critic::Utils::McCabe qw{ calculate_mccabe_of_sub }; #----------------------------------------------------------------------------- our $VERSION = '1.152'; #----------------------------------------------------------------------------- sub new { my ( $class ) = @_; my $self = bless {}, $class; $self->{_modules} = 0; $self->{_subs} = 0; $self->{_statements} = 0; $self->{_lines} = 0; $self->{_lines_of_blank} = 0; $self->{_lines_of_comment} = 0; $self->{_lines_of_data} = 0; $self->{_lines_of_perl} = 0; $self->{_lines_of_pod} = 0; $self->{_violations_by_policy} = {}; $self->{_violations_by_severity} = {}; $self->{_total_violations} = 0; return $self; } #----------------------------------------------------------------------------- sub accumulate { my ($self, $doc, $violations) = @_; $self->{_modules}++; my $subs = $doc->find('PPI::Statement::Sub'); if ($subs) { foreach my $sub ( @{$subs} ) { $self->{_subs}++; $self->{_subs_total_mccabe} += calculate_mccabe_of_sub( $sub ); } } my $statements = $doc->find('PPI::Statement'); $self->{_statements} += $statements ? scalar @{$statements} : 0; ## no critic (RequireDotMatchAnything, RequireExtendedFormatting, RequireLineBoundaryMatching) my @lines = split /$INPUT_RECORD_SEPARATOR/, $doc->serialize(); ## use critic $self->{_lines} += scalar @lines; { my ( $in_data, $in_pod ); foreach ( @lines ) { if ( q{=} eq substr $_, 0, 1 ) { ## no critic (ProhibitCascadingIfElse) $in_pod = not m/ \A \s* =cut \b /smx; $self->{_lines_of_pod}++; } elsif ( $in_pod ) { $self->{_lines_of_pod}++; } elsif ( q{__END__} eq $_ || q{__DATA__} eq $_ ) { $in_data = 1; $self->{_lines_of_perl}++; } elsif ( $in_data ) { $self->{_lines_of_data}++; } elsif ( m/ \A \s* \# /smx ) { $self->{_lines_of_comment}++; } elsif ( m/ \A \s* \z /smx ) { $self->{_lines_of_blank}++; } else { $self->{_lines_of_perl}++; } } } foreach my $violation ( @{ $violations } ) { $self->{_violations_by_severity}->{ $violation->severity() }++; $self->{_violations_by_policy}->{ $violation->policy() }++; $self->{_total_violations}++; } return; } #----------------------------------------------------------------------------- sub modules { my ( $self ) = @_; return $self->{_modules}; } #----------------------------------------------------------------------------- sub subs { my ( $self ) = @_; return $self->{_subs}; } #----------------------------------------------------------------------------- sub statements { my ( $self ) = @_; return $self->{_statements}; } #----------------------------------------------------------------------------- sub lines { my ( $self ) = @_; return $self->{_lines}; } #----------------------------------------------------------------------------- sub lines_of_blank { my ( $self ) = @_; return $self->{_lines_of_blank}; } #----------------------------------------------------------------------------- sub lines_of_comment { my ( $self ) = @_; return $self->{_lines_of_comment}; } #----------------------------------------------------------------------------- sub lines_of_data { my ( $self ) = @_; return $self->{_lines_of_data}; } #----------------------------------------------------------------------------- sub lines_of_perl { my ( $self ) = @_; return $self->{_lines_of_perl}; } #----------------------------------------------------------------------------- sub lines_of_pod { my ( $self ) = @_; return $self->{_lines_of_pod}; } #----------------------------------------------------------------------------- sub _subs_total_mccabe { my ( $self ) = @_; return $self->{_subs_total_mccabe}; } #----------------------------------------------------------------------------- sub violations_by_severity { my ( $self ) = @_; return $self->{_violations_by_severity}; } #----------------------------------------------------------------------------- sub violations_by_policy { my ( $self ) = @_; return $self->{_violations_by_policy}; } #----------------------------------------------------------------------------- sub total_violations { my ( $self ) = @_; return $self->{_total_violations}; } #----------------------------------------------------------------------------- sub statements_other_than_subs { my ( $self ) = @_; return $self->statements() - $self->subs(); } #----------------------------------------------------------------------------- sub average_sub_mccabe { my ( $self ) = @_; return if $self->subs() == 0; return $self->_subs_total_mccabe() / $self->subs(); } #----------------------------------------------------------------------------- sub violations_per_file { my ( $self ) = @_; return if $self->modules() == 0; return $self->total_violations() / $self->modules(); } #----------------------------------------------------------------------------- sub violations_per_statement { my ( $self ) = @_; my $statements = $self->statements_other_than_subs(); return if $statements == 0; return $self->total_violations() / $statements; } #----------------------------------------------------------------------------- sub violations_per_line_of_code { my ( $self ) = @_; return if $self->lines() == 0; return $self->total_violations() / $self->lines(); } #----------------------------------------------------------------------------- 1; __END__ #----------------------------------------------------------------------------- =pod =for stopwords McCabe =head1 NAME Perl::Critic::Statistics - Compile stats on Perl::Critic violations. =head1 DESCRIPTION This class accumulates statistics on Perl::Critic violations across one or more files. NOTE: This class is experimental and subject to change. =head1 INTERFACE SUPPORT This is considered to be a non-public class. Its interface is subject to change without notice. =head1 METHODS =over =item C Create a new instance of Perl::Critic::Statistics. No arguments are supported at this time. =item C< accumulate( $doc, \@violations ) > Accumulates statistics about the C<$doc> and the C<@violations> that were found. =item C The number of chunks of code (usually files) that have been analyzed. =item C The total number of subroutines analyzed by this Critic. =item C The total number of statements analyzed by this Critic. =item C The total number of lines of code analyzed by this Critic. =item C The total number of blank lines analyzed by this Critic. This includes only blank lines in code, not POD or data. =item C The total number of comment lines analyzed by this Critic. This includes only lines whose first non-whitespace character is C<#>. =item C The total number of lines of data section analyzed by this Critic, not counting the C<__END__> or C<__DATA__> line. POD in a data section is counted as POD, not data. =item C The total number of lines of Perl code analyzed by this Critic. Perl appearing in the data section is not counted. =item C The total number of lines of POD analyzed by this Critic. Pod occurring in a data section is counted as POD, not as data. =item C The number of violations of each severity found by this Critic as a reference to a hash keyed by severity. =item C The number of violations of each policy found by this Critic as a reference to a hash keyed by full policy name. =item C The total number of violations found by this Critic. =item C The total number of statements minus the number of subroutines. Useful because a subroutine is considered a statement by PPI. =item C The average McCabe score of all scanned subroutines. =item C The total violations divided by the number of modules. =item C The total violations divided by the number statements minus subroutines. =item C The total violations divided by the lines of code. =back =head1 AUTHOR Elliot Shank C<< >> =head1 COPYRIGHT Copyright (c) 2007-2011 Elliot Shank. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of this license can be found in the LICENSE file included with this module. =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 :