git.maemo.org Git - pkg-perl/blob - deb-src/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/Utils/McCabe.pm

   1 ##############################################################################
   2 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Utils/McCabe.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::Utils::McCabe;
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13
  14 use Readonly;
  15
  16 use Perl::Critic::Utils qw{ :data_conversion :classification };
  17
  18 use base 'Exporter';
  19
  20 #-----------------------------------------------------------------------------
  21
  22 our $VERSION = '1.088';
  23
  24 #-----------------------------------------------------------------------------
  25
  26 Readonly::Array our @EXPORT_OK =>
  27   qw( calculate_mccabe_of_sub calculate_mccabe_of_main );
  28
  29 #-----------------------------------------------------------------------------
  30
  31 Readonly::Hash my %LOGIC_OPS =>
  32     hashify( qw( && || ||= &&= or and xor ? <<= >>= ) );
  33
  34 Readonly::Hash my %LOGIC_KEYWORDS =>
  35     hashify( qw( if else elsif unless until while for foreach ) );
  36
  37 #-----------------------------------------------------------------------------
  38
  39 sub calculate_mccabe_of_sub {
  40
  41     my ( $sub ) = @_;
  42
  43     my $count = 1; # Minimum score is 1
  44     $count += _count_logic_keywords( $sub );
  45     $count += _count_logic_operators( $sub );
  46
  47     return $count;
  48 }
  49
  50 #-----------------------------------------------------------------------------
  51
  52 sub calculate_mccabe_of_main {
  53
  54     my ( $doc ) = @_;
  55
  56     my $count = 1; # Minimum score is 1
  57     $count += _count_main_logic_operators_and_keywords( $doc );
  58     return $count;
  59 }
  60
  61 #-----------------------------------------------------------------------------
  62
  63 sub _count_main_logic_operators_and_keywords {
  64
  65     my ( $doc ) = @_;
  66
  67     # I can't leverage Perl::Critic::Document's fast search mechanism here
  68     # because we're not searching for elements by class name.  So to speed
  69     # things up, search for both keywords and operators at the same time.
  70
  71     my $wanted = sub {
  72
  73         my (undef, $elem) = @_;
  74
  75         # Only count things that *are not* in a subroutine.  Returning an
  76         # explicit 'undef' here prevents PPI from descending into the node.
  77
  78         ## no critic Subroutines::ProhibitExplicitReturnUndef
  79         return undef if $elem->isa('PPI::Statement::Sub');
  80
  81
  82         if ( $elem->isa('PPI::Token::Word') ) {
  83             return 0 if is_hash_key( $elem );
  84             return exists $LOGIC_KEYWORDS{$elem};
  85         }
  86         elsif ($elem->isa('PPI::Token::Operator') ) {
  87             return exists $LOGIC_OPS{$elem};
  88         }
  89     };
  90
  91     my $logic_operators_and_keywords = $doc->find( $wanted );
  92
  93     my $count = $logic_operators_and_keywords ?
  94       scalar @{$logic_operators_and_keywords} : 0;
  95
  96     return $count;
  97 }
  98
  99 #-----------------------------------------------------------------------------
 100
 101 sub _count_logic_keywords {
 102
 103     my ( $sub ) = @_;
 104     my $count = 0;
 105
 106     # Here, I'm using this round-about method of finding elements so
 107     # that I can take advantage of Perl::Critic::Document's faster
 108     # find() mechanism.  It can only search for elements by class name.
 109
 110     my $keywords_ref = $sub->find('PPI::Token::Word');
 111     if ( $keywords_ref ) { # should always be true due to "sub" keyword
 112         my @filtered = grep { ! is_hash_key($_) } @{ $keywords_ref };
 113         $count = grep { exists $LOGIC_KEYWORDS{$_} } @filtered;
 114     }
 115     return $count;
 116 }
 117
 118 #-----------------------------------------------------------------------------
 119
 120 sub _count_logic_operators {
 121
 122     my ( $sub ) = @_;
 123     my $count = 0;
 124
 125     # Here, I'm using this round-about method of finding elements so
 126     # that I can take advantage of Perl::Critic::Document's faster
 127     # find() mechanism.  It can only search for elements by class name.
 128
 129     my $operators_ref = $sub->find('PPI::Token::Operator');
 130     if ( $operators_ref ) {
 131         $count = grep { exists $LOGIC_OPS{$_} }  @{ $operators_ref };
 132     }
 133
 134     return $count;
 135 }
 136
 137
 138 1;
 139
 140 __END__
 141
 142 #-----------------------------------------------------------------------------
 143
 144 =pod
 145
 146 =for stopwords McCabe
 147
 148 =head1 NAME
 149
 150 Perl::Critic::Utils::McCabe - Functions that calculate the McCabe score of source code.
 151
 152 =head1 DESCRIPTION
 153
 154 Provides approximations of McCabe scores.  The McCabe score of a set
 155 of code describes the number of possible paths through it.  The
 156 functions here approximate the McCabe score by summing the number of
 157 conditional statements and operators within a set of code.  See
 158 L<http://www.sei.cmu.edu/str/descriptions/cyclomatic_body.html> for
 159 some discussion about the McCabe number and other complexity metrics.
 160
 161
 162 =head1 IMPORTABLE SUBS
 163
 164 =over
 165
 166 =item C<calculate_mccabe_of_sub( $sub )>
 167
 168 Calculates an approximation of the McCabe number of the code in a
 169 L<PPI::Statement::Sub>.
 170
 171 =item C<calculate_mccabe_of_main( $doc )>
 172
 173 Calculates an approximation of the McCabe number of all the code in a
 174 L<PPI::Statement::Document> that is B<not> contained in a subroutine.
 175
 176 =back
 177
 178
 179 =head1 AUTHOR
 180
 181 Jeffrey Ryan Thalhammer <thaljef@cpan.org>
 182
 183 =head1 COPYRIGHT
 184
 185 Copyright (c) 2005-2008 Jeffrey Ryan Thalhammer.  All rights reserved.
 186
 187 This program is free software; you can redistribute it and/or modify
 188 it under the same terms as Perl itself.  The full text of this license
 189 can be found in the LICENSE file included with this module.
 190
 191 =cut
 192
 193 # Local Variables:
 194 #   mode: cperl
 195 #   cperl-indent-level: 4
 196 #   fill-column: 78
 197 #   indent-tabs-mode: nil
 198 #   c-indentation-style: bsd
 199 # End:
 200 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :