vcs.maemo.org Git - dh-make-perl/blob - dev/i386/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/Statistics.pm

   1 ##############################################################################
   2 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Statistics.pm $
   3 #     $Date: 2008-07-03 10:19:10 -0500 (Thu, 03 Jul 2008) $
   4 #   $Author: clonezone $
   5 # $Revision: 2489 $
   6 ##############################################################################
   7
   8 package Perl::Critic::Statistics;
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13
  14 use English qw(-no_match_vars);
  15
  16 use Perl::Critic::Utils::McCabe qw{ calculate_mccabe_of_sub };
  17
  18 #-----------------------------------------------------------------------------
  19
  20 our $VERSION = '1.088';
  21
  22 #-----------------------------------------------------------------------------
  23
  24 sub new {
  25     my ( $class ) = @_;
  26
  27     my $self = bless {}, $class;
  28
  29     $self->{_modules} = 0;
  30     $self->{_subs} = 0;
  31     $self->{_statements} = 0;
  32     $self->{_lines} = 0;
  33     $self->{_violations_by_policy} = {};
  34     $self->{_violations_by_severity} = {};
  35     $self->{_total_violations} = 0;
  36
  37     return $self;
  38 }
  39
  40 #-----------------------------------------------------------------------------
  41
  42 sub accumulate {
  43     my ($self, $doc, $violations) = @_;
  44
  45     $self->{_modules}++;
  46
  47     my $subs = $doc->find('PPI::Statement::Sub');
  48     if ($subs) {
  49         foreach my $sub ( @{$subs} ) {
  50             $self->{_subs}++;
  51             $self->{_subs_total_mccabe} += calculate_mccabe_of_sub( $sub );
  52         }
  53     }
  54
  55     my $statements = $doc->find('PPI::Statement');
  56     $self->{_statements} += $statements ? scalar @{$statements} : 0;
  57
  58     ## no critic (RequireExtendedFormatting, RequireLineBoundaryMatching)
  59     my @lines = split /$INPUT_RECORD_SEPARATOR/, $doc->serialize();
  60     ## use critic
  61     $self->{_lines} += scalar @lines;
  62
  63     foreach my $violation ( @{ $violations } ) {
  64         $self->{_violations_by_severity}->{ $violation->severity() }++;
  65         $self->{_violations_by_policy}->{ $violation->policy() }++;
  66         $self->{_total_violations}++;
  67     }
  68
  69     return;
  70 }
  71
  72 #-----------------------------------------------------------------------------
  73
  74 sub modules {
  75     my ( $self ) = @_;
  76
  77     return $self->{_modules};
  78 }
  79
  80 #-----------------------------------------------------------------------------
  81
  82 sub subs {
  83     my ( $self ) = @_;
  84
  85     return $self->{_subs};
  86 }
  87
  88 #-----------------------------------------------------------------------------
  89
  90 sub statements {
  91     my ( $self ) = @_;
  92
  93     return $self->{_statements};
  94 }
  95
  96 #-----------------------------------------------------------------------------
  97
  98 sub lines {
  99     my ( $self ) = @_;
 100
 101     return $self->{_lines};
 102 }
 103
 104 #-----------------------------------------------------------------------------
 105
 106 sub _subs_total_mccabe {
 107     my ( $self ) = @_;
 108
 109     return $self->{_subs_total_mccabe};
 110 }
 111
 112 #-----------------------------------------------------------------------------
 113
 114 sub violations_by_severity {
 115     my ( $self ) = @_;
 116
 117     return $self->{_violations_by_severity};
 118 }
 119
 120 #-----------------------------------------------------------------------------
 121
 122 sub violations_by_policy {
 123     my ( $self ) = @_;
 124
 125     return $self->{_violations_by_policy};
 126 }
 127
 128 #-----------------------------------------------------------------------------
 129
 130 sub total_violations {
 131     my ( $self ) = @_;
 132
 133     return $self->{_total_violations};
 134 }
 135
 136 #-----------------------------------------------------------------------------
 137
 138 sub statements_other_than_subs {
 139     my ( $self ) = @_;
 140
 141     return $self->statements() - $self->subs();
 142 }
 143
 144 #-----------------------------------------------------------------------------
 145
 146 sub average_sub_mccabe {
 147     my ( $self ) = @_;
 148
 149     return if $self->subs() == 0;
 150
 151     return $self->_subs_total_mccabe() / $self->subs();
 152 }
 153
 154 #-----------------------------------------------------------------------------
 155
 156 sub violations_per_file {
 157     my ( $self ) = @_;
 158
 159     return if $self->modules() == 0;
 160
 161     return $self->total_violations() / $self->modules();
 162 }
 163
 164 #-----------------------------------------------------------------------------
 165
 166 sub violations_per_statement {
 167     my ( $self ) = @_;
 168
 169     my $statements = $self->statements_other_than_subs();
 170
 171     return if $statements == 0;
 172
 173     return $self->total_violations() / $statements;
 174 }
 175
 176 #-----------------------------------------------------------------------------
 177
 178 sub violations_per_line_of_code {
 179     my ( $self ) = @_;
 180
 181     return if $self->lines() == 0;
 182
 183     return $self->total_violations() / $self->lines();
 184 }
 185
 186 #-----------------------------------------------------------------------------
 187
 188 1;
 189
 190 __END__
 191
 192 #-----------------------------------------------------------------------------
 193
 194 =pod
 195
 196 =for stopwords McCabe
 197
 198 =head1 NAME
 199
 200 Perl::Critic::Statistics - Compile stats on Perl::Critic violations.
 201
 202
 203 =head1 DESCRIPTION
 204
 205 This class accumulates statistics on Perl::Critic violations across one or
 206 more files.  NOTE: This class is experimental and subject to change.
 207
 208
 209 =head1 METHODS
 210
 211 =over
 212
 213 =item C<new()>
 214
 215 Create a new instance of Perl::Critic::Statistics.  No arguments are supported
 216 at this time.
 217
 218
 219 =item C< accumulate( $doc, \@violations ) >
 220
 221 Accumulates statistics about the C<$doc> and the C<@violations> that were
 222 found.
 223
 224
 225 =item C<modules()>
 226
 227 The number of chunks of code (usually files) that have been analyzed.
 228
 229
 230 =item C<subs()>
 231
 232 The total number of subroutines analyzed by this Critic.
 233
 234
 235 =item C<statements()>
 236
 237 The total number of statements analyzed by this Critic.
 238
 239
 240 =item C<lines()>
 241
 242 The total number of lines of code analyzed by this Critic.
 243
 244
 245 =item C<violations_by_severity()>
 246
 247 The number of violations of each severity found by this Critic as a
 248 reference to a hash keyed by severity.
 249
 250
 251 =item C<violations_by_policy()>
 252
 253 The number of violations of each policy found by this Critic as a
 254 reference to a hash keyed by full policy name.
 255
 256
 257 =item C<total_violations()>
 258
 259 The the total number of violations found by this Critic.
 260
 261
 262 =item C<statements_other_than_subs()>
 263
 264 The total number of statements minus the number of subroutines.
 265 Useful because a subroutine is considered a statement by PPI.
 266
 267
 268 =item C<average_sub_mccabe()>
 269
 270 The average McCabe score of all scanned subroutines.
 271
 272
 273 =item C<violations_per_file()>
 274
 275 The total violations divided by the number of modules.
 276
 277
 278 =item C<violations_per_statement()>
 279
 280 The total violations divided by the number statements minus
 281 subroutines.
 282
 283
 284 =item C<violations_per_line_of_code()>
 285
 286 The total violations divided by the lines of code.
 287
 288
 289 =back
 290
 291
 292 =head1 AUTHOR
 293
 294 Elliot Shank C<< <perl@galumph.com> >>
 295
 296
 297 =head1 COPYRIGHT
 298
 299 Copyright (c) 2007-2008 Elliot Shank
 300
 301 This program is free software; you can redistribute it and/or modify
 302 it under the same terms as Perl itself.  The full text of this license
 303 can be found in the LICENSE file included with this module.
 304
 305 =cut
 306
 307 ##############################################################################
 308 # Local Variables:
 309 #   mode: cperl
 310 #   cperl-indent-level: 4
 311 #   fill-column: 78
 312 #   indent-tabs-mode: nil
 313 #   c-indentation-style: bsd
 314 # End:
 315 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :