File Coverage

lib/Perl/Metrics/Simple/Output/HTML.pm
Criterion Covered Total %
statement 12 123 9.7
branch 0 4 0.0
condition 0 20 0.0
subroutine 4 17 23.5
pod 0 13 0.0
total 16 177 9.0


'; '; '; ';
line stmt bran cond sub pod time code
1             package Perl::Metrics::Simple::Output::HTML;
2              
3 1     1   769 use strict;
  1         3  
  1         30  
4 1     1   4 use warnings;
  1         3  
  1         27  
5              
6 1     1   476 use parent qw(Perl::Metrics::Simple::Output);
  1         314  
  1         5  
7 1     1   588 use Readonly 1.03;
  1         3978  
  1         1549  
8              
9             our $VERSION = 'v1.0.3';
10              
11             Readonly my $EMPTY_STRING => q{};
12             Readonly my $ONE_SPACE => q{ };
13              
14             Readonly my $COMPLEXITY_LEVEL_THRESHOLD => {
15             BTW => 10,
16             WTF => 20,
17             OMG => 30,
18             };
19              
20             Readonly my $THRESHOLD_TO_CSS_CLASS => {
21             0 => 'fyi',
22             $COMPLEXITY_LEVEL_THRESHOLD->{BTW} => 'btw',
23             $COMPLEXITY_LEVEL_THRESHOLD->{WTF} => 'wtf',
24             $COMPLEXITY_LEVEL_THRESHOLD->{OMG} => 'omg',
25             };
26              
27             Readonly my $CSS => {
28             body => ['font-family:sans-serif;'],
29             table => [
30             'border-collapse:collapse;', 'border-spacing:0px;',
31             'margin:10px 0px;'
32             ],
33             tr => [ 'text-align:left;', 'vertical-align:top;' ],
34             'td, th' => [ 'border:solid 1px #000000;', 'padding:2px;' ],
35             th => ['background-color:#cccccc;'],
36             '.fyi' => ['background-color:#99ff99;'],
37             '.btw' => ['background-color:#ffff99;'],
38             '.wtf' => ['background-color:#ffcc99;'],
39             '.omg' => ['background-color:#ff9999;'],
40             '.w300' => ['width:300px;'],
41             '.w200' => ['width:200px;'],
42             '.w100' => ['width:100px;'],
43             '.right' => ['text-align:right;']
44             };
45              
46             sub make_report {
47 0     0 0   my ($self) = @_;
48              
49 0           my $html = '';
50              
51 0           $html .= $self->make_head();
52              
53 0           $html .= $self->make_body();
54              
55 0           $html .= '';
56 0           return $html;
57             }
58              
59             sub make_head {
60 0     0 0   my ($self) = @_;
61              
62 0           my $head = 'countperl';
63              
64 0           $head .= make_css();
65              
66 0           $head .= '';
67 0           return $head;
68             }
69              
70             sub make_css {
71 0     0 0   my ($self) = @_;
72              
73 0           my $css = '';
86              
87 0           return $css;
88             }
89              
90             sub make_body {
91 0     0 0   my ($self) = @_;
92              
93 0           my $body = '

';

94 0           $body .= 'Perl files found ' . $self->analysis()->file_count();
95 0           $body .= '';
96              
97 0           $body .= $self->make_counts();
98 0           $body .= $self->make_subroutine_size();
99 0           $body .= $self->make_code_complexity();
100 0           $body .= $self->make_list_of_subs();
101 0           $body .= $self->make_complexity_levels();
102              
103 0           $body .= '';
104 0           return $body;
105             }
106              
107             sub make_counts {
108 0     0 0   my ($self) = @_;
109              
110 0           my $analysis = $self->analysis();
111              
112 0           my $counts = '';
Counts
113              
114 0           $counts .= make_tr( 'total code lines', $analysis->lines() );
115             $counts
116 0           .= make_tr( 'lines of non-sub code', $analysis->main_stats()->{lines} );
117 0           $counts .= make_tr( 'packages found', $analysis->package_count() );
118 0           $counts .= make_tr( 'subs/methods', $analysis->sub_count() );
119              
120 0           $counts .= '
';
121 0           return $counts;
122             }
123              
124             sub make_tr {
125 0     0 0   my ( $key, $value, $css ) = @_;
126 0 0         $css = $css ? $ONE_SPACE . $css : $EMPTY_STRING;
127              
128 0           my $tr = '
';
129 0           $tr .= $key;
130 0           $tr .= '';
131 0           $tr .= $value;
132 0           $tr .= '
133              
134 0           return $tr;
135             }
136              
137             sub make_subroutine_size {
138 0     0 0   my ($self) = @_;
139              
140 0           my $analysis = $self->analysis();
141              
142 0           my $subroutine_size = '';
Subroutine/Method Size
143              
144 0   0       my $min = $analysis->summary_stats()->{sub_length}->{min} || 0;
145 0   0       my $max = $analysis->summary_stats()->{sub_length}->{max} || 0;
146 0   0       my $mean = $analysis->summary_stats()->{sub_length}->{mean} || '0.00';
147 0   0       my $standard_deviation = $analysis->summary_stats()->{sub_length}->{standard_deviation} || '0.00';
148 0   0       my $median = $analysis->summary_stats()->{sub_length}->{median} || '0.00';
149              
150 0           $subroutine_size .= make_tr( 'min', $min );
151 0           $subroutine_size .= make_tr( 'max', $max );
152 0           $subroutine_size .= make_tr( 'mean', $mean );
153 0           $subroutine_size .= make_tr( 'std. deviation', $standard_deviation );
154 0           $subroutine_size .= make_tr( 'median', $median );
155              
156 0           $subroutine_size .= '
';
157              
158 0           return $subroutine_size;
159             }
160              
161             sub make_code_complexity {
162 0     0 0   my ($self) = @_;
163              
164 0           my $code_complexity = '';
McCabe Complexity
165              
166 0           $code_complexity .= $self->make_complexity_section(
167             'Code not in any subroutine',
168             'main_complexity'
169             );
170 0           $code_complexity .= $self->make_complexity_section(
171             'Subroutines/Methods',
172             'sub_complexity'
173             );
174              
175 0           $code_complexity .= '
';
176              
177 0           return $code_complexity;
178             }
179              
180             sub make_complexity_section {
181 0     0 0   my ( $self, $section, $key ) = @_;
182              
183 0           my $analysis = $self->analysis();
184              
185 0           my $complexity_section = '
' . $section . '
186              
187 0   0       my $min = $analysis->summary_stats()->{$key}->{min} || 0;
188 0   0       my $max = $analysis->summary_stats()->{$key}->{max} || 0;
189 0   0       my $mean = $analysis->summary_stats()->{$key}->{mean} || '0.00';
190 0   0       my $standard_deviation = $analysis->summary_stats()->{$key}->{standard_deviation} || '0.00';
191 0   0       my $median = $analysis->summary_stats()->{$key}->{median} || '0.00';
192              
193 0           $complexity_section .= 'min';
194 0           $complexity_section .= $min;
195 0           $complexity_section .= '
196              
197 0           $complexity_section .= make_tr( 'max', $max, get_class_by_count($max) );
198 0           $complexity_section .= make_tr( 'mean', $mean, get_class_by_count($mean) );
199 0           $complexity_section .= make_tr( 'std. deviation', $standard_deviation, get_class_by_count($standard_deviation) );
200 0           $complexity_section .= make_tr( 'median', $median, get_class_by_count($median) );
201              
202 0           return $complexity_section;
203             }
204              
205             sub make_list_of_subs_tr {
206 0     0 0   my ($sub) = @_;
207              
208 0           my $list_of_subs_tr = '
' . $sub->{mccabe_complexity} . '' . $sub->{name} . '' . $sub->{path} . '' . $sub->{lines} . '
209              
210 0           return $list_of_subs_tr;
211             }
212              
213             sub make_list_of_subs {
214 0     0 0   my ($self) = @_;
215              
216 0           my $sorted_subs = $self->SUPER::make_list_of_subs()->[1];
217              
218 0           my $list_of_subs = '' . '';
List of subroutines, with most complex at top
complexitysubpathsize
219              
220 0           foreach my $sub (@{$sorted_subs}) {
  0            
221 0           $list_of_subs .= make_list_of_subs_tr($sub);
222             }
223              
224 0           $list_of_subs .= '
';
225              
226 0           return $list_of_subs;
227             }
228              
229             sub make_complexity_levels {
230 0     0 0   my ($self) = @_;
231              
232 0           my $complexity_levels = ''; ';
Complexity Levels
233              
234 0           foreach my $level ( sort keys %{$THRESHOLD_TO_CSS_CLASS} ) {
  0            
235 0           $complexity_levels .= '
' . $THRESHOLD_TO_CSS_CLASS->{$level} . '' . '>= ' . $level . '
236             }
237              
238 0           $complexity_levels .= '
';
239              
240 0           return $complexity_levels;
241             }
242              
243             sub get_class_by_count {
244 0     0 0   my ($count) = @_;
245              
246 0           my @level = reverse sort keys %{$THRESHOLD_TO_CSS_CLASS};
  0            
247              
248 0           foreach (@level) {
249 0 0         return $THRESHOLD_TO_CSS_CLASS->{$_} if ( $count >= $_ );
250             }
251 0           return;
252             }
253              
254             1; # Keep Perl happy, snuggy, and warm.
255              
256             __END__