File Coverage

blib/lib/Perl/Metrics/Halstead.pm
Criterion Covered Total %
statement 89 89 100.0
branch 10 12 83.3
condition 4 8 50.0
subroutine 21 21 100.0
pod 2 3 66.6
total 126 133 94.7


line stmt bran cond sub pod time code
1             package Perl::Metrics::Halstead;
2             our $AUTHORITY = 'cpan:GENE';
3              
4             # ABSTRACT: Compute Halstead complexity metrics
5              
6             our $VERSION = '0.0617';
7              
8 1     1   1015 use strictures 2;
  1         1328  
  1         32  
9 1     1   579 use Moo;
  1         9221  
  1         4  
10 1     1   1679 use PPI::Document ();
  1         87361  
  1         24  
11 1     1   411 use PPI::Dumper ();
  1         813  
  1         22  
12 1     1   368 use namespace::clean;
  1         9491  
  1         7  
13              
14              
15             has file => (
16             is => 'ro',
17             required => 1,
18             );
19              
20              
21             has [qw(
22             n_operators
23             n_operands
24             n_distinct_operators
25             n_distinct_operands
26             )] => (
27             is => 'ro',
28             init_arg => undef,
29             );
30              
31              
32             has [qw(
33             prog_vocab
34             prog_length
35             est_prog_length
36             volume
37             difficulty
38             level
39             lang_level
40             intel_content
41             effort
42             time_to_program
43             delivered_bugs
44             )] => (
45             is => 'lazy',
46             init_arg => undef,
47             builder => 1,
48             );
49              
50             sub _build_prog_vocab {
51 2     2   2540 my ($self) = @_;
52 2         25 return $self->n_distinct_operators + $self->n_distinct_operands;
53             }
54              
55             sub _build_prog_length {
56 2     2   20 my ($self) = @_;
57 2         26 return $self->n_operators + $self->n_operands;
58             }
59              
60             sub _build_est_prog_length {
61 2     2   21 my ($self) = @_;
62 2         11 return $self->n_distinct_operators * _log2($self->n_distinct_operators)
63             + $self->n_distinct_operands * _log2($self->n_distinct_operands);
64             }
65              
66             sub _build_volume {
67 2     2   19 my ($self) = @_;
68 2         28 return $self->prog_length * _log2($self->prog_vocab);
69             }
70              
71             sub _build_difficulty {
72 5     5   2176 my ($self) = @_;
73 5         65 return ($self->n_distinct_operators / 2)
74             * ($self->n_operands / $self->n_distinct_operands);
75             }
76              
77             sub _build_level {
78 2     2   17 my ($self) = @_;
79 2         28 return 1 / $self->difficulty;
80             }
81              
82             sub _build_lang_level {
83 2     2   528 my ($self) = @_;
84 2         32 return $self->volume / $self->difficulty / $self->difficulty;
85             }
86              
87             sub _build_intel_content {
88 2     2   571 my ($self) = @_;
89 2         27 return $self->volume / $self->difficulty;
90             }
91              
92             sub _build_effort {
93 2     2   588 my ($self) = @_;
94 2         29 return $self->difficulty * $self->volume;
95             }
96              
97             sub _build_time_to_program {
98 2     2   604 my ($self) = @_;
99 2         27 return $self->effort / 18;
100             }
101              
102             sub _build_delivered_bugs {
103 2     2   543 my ($self) = @_;
104 2         26 return ($self->effort ** (2/3)) / 3000;
105             }
106              
107              
108             sub BUILD {
109 6     6 0 12472 my ( $self, $args ) = @_;
110              
111 6         46 my $doc = PPI::Document->new( $self->file );
112              
113 6         19241 my $dump = PPI::Dumper->new( $doc, whitespace => 0, comments => 0 );
114              
115 6 100       320 die 'No document parsed for ', $self->file, ". Computation can't continue.\n"
116             unless $dump;
117              
118 5         11 my %halstead;
119              
120 5         16 for my $item ( $dump->list ) {
121 100         4843 $item =~ s/^\s*//;
122 100         404 $item =~ s/\s*$//;
123 100         217 my @item = split /\s+/, $item, 2;
124 100 100       186 next unless defined $item[1];
125 72 50 33     177 next if $item[0] eq 'PPI::Token::Pod' or $item[0] eq 'PPI::Token::End';
126 72         85 push @{ $halstead{ $item[0] } }, $item[1];
  72         179  
127             }
128              
129 5         33 $self->{n_operators} = 0;
130 5         11 $self->{n_operands} = 0;
131              
132 5         19 for my $key ( keys %halstead ) {
133 23 100       45 if ( _is_operand($key) ) {
134 8         14 $self->{n_operands} += @{ $halstead{$key} };
  8         15  
135             }
136             else {
137 15         24 $self->{n_operators} += @{ $halstead{$key} };
  15         26  
138             }
139             }
140              
141 5         8 my %distinct;
142              
143 5         12 for my $key ( keys %halstead ) {
144 23         32 for my $item ( @{ $halstead{$key} } ) {
  23         30  
145 72 100       98 if ( _is_operand($key) ) {
146 11         28 $distinct{operands}->{$item} = undef;
147             }
148             else {
149 61         134 $distinct{operators}->{$item} = undef;
150             }
151             }
152             }
153              
154 5         9 $self->{n_distinct_operators} = keys %{ $distinct{operators} };
  5         14  
155 5         7 $self->{n_distinct_operands} = keys %{ $distinct{operands} };
  5         12  
156              
157             die 'No distinct operands for ', $self->file, ". Computation cannot continue.\n"
158 5 50       63 unless $self->{n_distinct_operands};
159             }
160              
161              
162             sub report {
163 1     1 1 2171 my ( $self, $precision ) = @_;
164              
165 1   50     6 $precision //= 2;
166              
167 1         25 printf "Total operators: %d + Total operands: %d = Program length: %d\n",
168             $self->n_operators, $self->n_operands, $self->prog_length;
169 1         74 printf "Distinct operators: %d + Distinct operands: %d = Program vocabulary: %d\n",
170             $self->n_distinct_operators, $self->n_distinct_operands, $self->prog_vocab;
171 1         40 printf "Estimated program length: %.*f\n", $precision, $self->est_prog_length;
172 1         47 printf "Program volume: %.*f\n", $precision, $self->volume;
173 1         41 printf "Program difficulty: %.*f\n", $precision, $self->difficulty;
174 1         38 printf "Program level: %.*f\n", $precision, $self->level;
175 1         49 printf "Program language level: %.*f\n", $precision, $self->lang_level;
176 1         42 printf "Program intelligence content: %.*f\n", $precision, $self->intel_content;
177 1         41 printf "Program effort: %.*f\n", $precision, $self->effort;
178 1         41 printf "Time to program: %.*f\n", $precision, $self->time_to_program;
179 1         39 printf "Delivered bugs: %.*f\n", $precision, $self->delivered_bugs;
180             }
181              
182              
183             sub dump {
184 1     1 1 540 my ($self) = @_;
185             return {
186 1         32 n_operators => $self->n_operators,
187             n_operands => $self->n_operands,
188             n_distinct_operators => $self->n_distinct_operators,
189             n_distinct_operands => $self->n_distinct_operands,
190             prog_vocab => $self->prog_vocab,
191             prog_length => $self->prog_length,
192             est_prog_length => $self->est_prog_length,
193             volume => $self->volume,
194             difficulty => $self->difficulty,
195             level => $self->level,
196             lang_level => $self->lang_level,
197             intel_content => $self->intel_content,
198             effort => $self->effort,
199             time_to_program => $self->time_to_program,
200             delivered_bugs => $self->delivered_bugs,
201             };
202             }
203              
204             sub _is_operand {
205 95     95   116 my $key = shift;
206 95   66     477 return $key =~ /Number/
207             || $key eq 'PPI::Token::Symbol'
208             || $key eq 'PPI::Token::HereDoc'
209             || $key eq 'PPI::Token::Data'
210             || $key =~ /Quote/;
211             }
212              
213             sub _log2 {
214 6     6   46 my $n = shift;
215 6         84 return log($n) / log(2);
216             }
217              
218             1;
219              
220             __END__