File Coverage

blib/lib/Perl/ToPerl6/Utils/McCabe.pm
Criterion Covered Total %
statement 37 56 66.0
branch 2 14 14.2
condition n/a
subroutine 9 12 75.0
pod 2 2 100.0
total 50 84 59.5


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