File: | lib/Code/Statistics/Reporter.pm |
Coverage: | 96.4% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | 1 1 1 | 0 0 0 | use strict; | ||||
2 | 1 1 1 | 0 0 0 | use warnings; | ||||
3 | |||||||
4 | package Code::Statistics::Reporter; | ||||||
5 | |||||||
6 | # ABSTRACT: creates reports statistics and outputs them | ||||||
7 | |||||||
8 | 1 1 1 | 0 0 0 | use 5.004; | ||||
9 | |||||||
10 | 1 1 1 | 0 0 0 | use Moose; | ||||
11 | 1 1 1 | 0 0 0 | use MooseX::HasDefaults::RO; | ||||
12 | 1 1 1 | 0 0 0 | use Code::Statistics::MooseTypes; | ||||
13 | |||||||
14 | 1 1 1 | 0 0 0 | use Carp 'confess'; | ||||
15 | 1 1 1 | 0 0 0 | use JSON 'from_json'; | ||||
16 | 1 1 1 | 0 0 0 | use File::Slurp 'read_file'; | ||||
17 | 1 1 1 | 0 0 0 | use List::Util qw( reduce max sum min ); | ||||
18 | 1 1 1 | 0 0 0 | use Data::Section -setup; | ||||
19 | 1 1 1 | 0 0 0 | use Template; | ||||
20 | 1 1 1 | 0 0 0 | use List::MoreUtils qw( uniq ); | ||||
21 | 1 1 1 | 0 0 0 | use Clone::Fast qw( clone ); | ||||
22 | |||||||
23 | has quiet => ( isa => 'Bool' ); | ||||||
24 | |||||||
25 | has file_ignore => ( | ||||||
26 | isa => 'CS::InputList', | ||||||
27 | coerce => 1, | ||||||
28 | default => sub {[]}, | ||||||
29 | ); | ||||||
30 | |||||||
31 | has screen_width => ( isa => 'Int', default => 80 ); | ||||||
32 | has min_path_width => ( isa => 'Int', default => 12 ); | ||||||
33 | has table_length => ( isa => 'Int', default => 10 ); | ||||||
34 | |||||||
35 - 37 | =head2 reports Creates a report on given code statistics and outputs it in some way. =cut | ||||||
38 | |||||||
39 | sub report { | ||||||
40 | 1 | 1 | 0 | my ( $self ) = @_; | |||
41 | |||||||
42 | 1 | 0 | my $stats = from_json read_file('codestat.out'); | ||||
43 | |||||||
44 | 1 1 | 0 0 | $stats->{files} = $self->_strip_ignored_files( @{ $stats->{files} } ); | ||||
45 | 1 | 0 | $stats->{target_types} = $self->_prepare_target_types( $stats->{files} ); | ||||
46 | |||||||
47 | 1 1 1 | 0 0 0 | $_->{metrics} = $self->_process_target_type( $_, $stats->{metrics} ) for @{$stats->{target_types}}; | ||||
48 | |||||||
49 | 1 | 0 | my $output; | ||||
50 | 1 | 0 | my $tmpl = $self->section_data( 'dos_template' ); | ||||
51 | 1 | 0 | my $tt = Template->new( STRICT => 1 ); | ||||
52 | $tt->process( | ||||||
53 | $tmpl, | ||||||
54 | { | ||||||
55 | targets => $stats->{target_types}, | ||||||
56 | truncate_front => sub { | ||||||
57 | 92 | 0 | my ( $string, $length ) = @_; | ||||
58 | 92 | 0 | return $string if $length >= length $string; | ||||
59 | 0 | 0 | return substr $string, 0-$length, $length; | ||||
60 | }, | ||||||
61 | }, | ||||||
62 | 1 | 0 | \$output | ||||
63 | ) or confess $tt->error; | ||||||
64 | |||||||
65 | 1 | 0 | print $output if !$self->quiet; | ||||
66 | |||||||
67 | 1 | 0 | return $output; | ||||
68 | } | ||||||
69 | |||||||
70 | sub _strip_ignored_files { | ||||||
71 | 1 | 0 | my ( $self, @files ) = @_; | ||||
72 | |||||||
73 | 1 2 1 | 0 0 0 | my @ignore_regexes = grep { $_ } @{ $self->file_ignore }; | ||||
74 | |||||||
75 | 1 | 0 | for my $re ( @ignore_regexes ) { | ||||
76 | 1 4 | 0 0 | @files = grep { $_->{path} !~ $re } @files; | ||||
77 | } | ||||||
78 | |||||||
79 | 1 | 0 | return \@files; | ||||
80 | } | ||||||
81 | |||||||
82 | sub _sort_columns { | ||||||
83 | 7 | 0 | my ( $self, %widths ) = @_; | ||||
84 | |||||||
85 | # get all columns in the right order | ||||||
86 | 7 | 0 | my @start_columns = qw( path line col ); | ||||
87 | 7 | 0 | my %end_columns = ( 'deviation' => 1 ); | ||||
88 | 7 70 | 0 0 | my @columns = uniq grep { !$end_columns{$_} } @start_columns, keys %widths; | ||||
89 | 7 | 0 | push @columns, keys %end_columns; | ||||
90 | |||||||
91 | 7 49 | 0 0 | @columns = grep { $widths{$_} } @columns; # remove the ones that have no data | ||||
92 | |||||||
93 | # expand the rest | ||||||
94 | 7 | 0 | @columns = map $self->_make_col_hash( $_, \%widths ), @columns; | ||||
95 | |||||||
96 | # calculate the width left over for the first column | ||||||
97 | 7 | 0 | my $used_width = sum( values %widths ) - $columns[0]{width}; | ||||
98 | 7 | 0 | my $first_col_width = $self->screen_width - $used_width; | ||||
99 | |||||||
100 | # special treatment for the first column | ||||||
101 | 7 | 0 | for ( @columns[0..0] ) { | ||||
102 | 7 | 0 | $_->{width} = max( $self->min_path_width, $first_col_width ); | ||||
103 | 7 | 0 | $_->{printname} = substr $_->{printname}, 1; | ||||
104 | } | ||||||
105 | |||||||
106 | 7 | 0 | return \@columns; | ||||
107 | } | ||||||
108 | |||||||
109 | sub _make_col_hash { | ||||||
110 | 49 | 0 | my ( $self, $col, $widths ) = @_; | ||||
111 | |||||||
112 | 49 | 0 | my $short_name = $self->_col_short_name($_); | ||||
113 | 49 | 0 | my $col_hash = { | ||||
114 | name => $_, | ||||||
115 | width => $widths->{$_}, | ||||||
116 | printname => " $short_name", | ||||||
117 | }; | ||||||
118 | |||||||
119 | 49 | 0 | return $col_hash; | ||||
120 | } | ||||||
121 | |||||||
122 | sub _prepare_target_types { | ||||||
123 | 1 | 0 | my ( $self, $files ) = @_; | ||||
124 | |||||||
125 | 1 | 0 | my %target_types; | ||||
126 | |||||||
127 | 1 1 | 0 0 | for my $file ( @{$files} ) { | ||||
128 | 3 3 | 0 0 | for my $target_type ( keys %{$file->{measurements}} ) { | ||||
129 | 7 7 | 0 0 | for my $target ( @{$file->{measurements}{$target_type}} ) { | ||||
130 | 37 | 0 | $target->{path} = $file->{path}; | ||||
131 | 37 37 | 0 0 | push @{ $target_types{$target_type}->{list} }, $target; | ||||
132 | } | ||||||
133 | } | ||||||
134 | } | ||||||
135 | |||||||
136 | 1 1 | 0 0 | $target_types{$_}->{type} = $_ for keys %target_types; | ||||
137 | |||||||
138 | 1 | 0 | return [ values %target_types ]; | ||||
139 | } | ||||||
140 | |||||||
141 | sub _process_target_type { | ||||||
142 | 3 | 0 | my ( $self, $target_type, $metrics ) = @_; | ||||
143 | |||||||
144 | 3 3 | 0 0 | my @metric = map $self->_process_metric( $target_type, $_ ), @{$metrics}; | ||||
145 | |||||||
146 | 3 | 0 | return \@metric; | ||||
147 | } | ||||||
148 | |||||||
149 | sub _process_metric { | ||||||
150 | 21 | 0 | my ( $self, $target_type, $metric ) = @_; | ||||
151 | |||||||
152 | 21 | 0 | return if "Code::Statistics::Metric::$metric"->is_insignificant; | ||||
153 | 9 9 | 0 0 | return if !$target_type->{list} or !@{$target_type->{list}}; | ||||
154 | 9 | 0 | return if !exists $target_type->{list}[0]{$metric}; | ||||
155 | |||||||
156 | 9 279 9 | 0 0 0 | my @list = reverse sort { $a->{$metric} <=> $b->{$metric} } @{$target_type->{list}}; | ||||
157 | |||||||
158 | 9 | 0 | my $metric_data = { type => $metric }; | ||||
159 | |||||||
160 | 9 | 0 | $metric_data->{avg} = $self->_calc_average( $metric, @list ); | ||||
161 | |||||||
162 | 9 | 0 | $self->_prepare_metric_tables( $metric_data, @list ) if $metric_data->{avg} and $metric_data->{avg} != 1; | ||||
163 | |||||||
164 | 9 | 0 | return $metric_data; | ||||
165 | } | ||||||
166 | |||||||
167 | sub _prepare_metric_tables { | ||||||
168 | 7 | 0 | my ( $self, $metric_data, @list ) = @_; | ||||
169 | |||||||
170 | 7 | 0 | $metric_data->{top} = $self->_get_top( @list ); | ||||
171 | 7 | 0 | $metric_data->{bottom} = $self->_get_bottom( @list ); | ||||
172 | 7 7 7 7 | 0 0 0 0 | $self->_calc_deviation( $_, $metric_data ) for ( @{$metric_data->{top}}, @{$metric_data->{bottom}} ); | ||||
173 | 7 | 0 | $metric_data->{widths} = $self->_calc_widths( $metric_data ); | ||||
174 | 7 7 | 0 0 | $metric_data->{columns} = $self->_sort_columns( %{ $metric_data->{widths} } ); | ||||
175 | |||||||
176 | 7 | 0 | return; | ||||
177 | } | ||||||
178 | |||||||
179 | sub _calc_deviation { | ||||||
180 | 92 | 0 | my ( $self, $line, $metric_data ) = @_; | ||||
181 | |||||||
182 | 92 | 0 | my $avg = $metric_data->{avg}; | ||||
183 | 92 | 0 | my $type = $metric_data->{type}; | ||||
184 | |||||||
185 | 92 | 0 | my $deviation = $line->{$type} / $avg; | ||||
186 | 92 | 0 | $line->{deviation} = sprintf '%.2f', $deviation; | ||||
187 | |||||||
188 | 92 | 0 | return; | ||||
189 | } | ||||||
190 | |||||||
191 | sub _calc_widths { | ||||||
192 | 7 | 0 | my ( $self, $metric_data ) = @_; | ||||
193 | |||||||
194 | 7 7 | 0 0 | my @entries = @{$metric_data->{top}}; | ||||
195 | 7 7 | 0 0 | @entries = ( @entries, @{$metric_data->{bottom}} ); | ||||
196 | |||||||
197 | 7 7 | 0 0 | my @columns = keys %{$entries[0]}; | ||||
198 | |||||||
199 | 7 | 0 | my %widths; | ||||
200 | 7 | 0 | for my $col ( @columns ) { | ||||
201 | 49 644 | 0 15625 | my @lengths = map { length $_->{$col} } @entries; | ||||
202 | 49 | 0 | push @lengths, length $self->_col_short_name($col); | ||||
203 | 49 | 0 | my $max = max @lengths; | ||||
204 | 49 | 0 | $widths{$col} = $max; | ||||
205 | } | ||||||
206 | |||||||
207 | 7 7 | 0 0 | $_++ for values %widths; | ||||
208 | |||||||
209 | 7 | 0 | return \%widths; | ||||
210 | } | ||||||
211 | |||||||
212 | sub _calc_average { | ||||||
213 | 9 | 0 | my ( $self, $metric, @list ) = @_; | ||||
214 | |||||||
215 | 9 111 | 0 0 | my $sum = reduce { $a + $b->{$metric} } 0, @list; | ||||
216 | 9 | 0 | my $average = $sum / @list; | ||||
217 | |||||||
218 | 9 | 0 | return $average; | ||||
219 | } | ||||||
220 | |||||||
221 | sub _get_top { | ||||||
222 | 7 | 0 | my ( $self, @list ) = @_; | ||||
223 | |||||||
224 | 7 | 0 | my $slice_end = min( $#list, $self->table_length - 1 ); | ||||
225 | 7 56 | 0 0 | my @top = grep { defined } @list[ 0 .. $slice_end ]; | ||||
226 | |||||||
227 | 7 | 0 | return clone \@top; | ||||
228 | } | ||||||
229 | |||||||
230 | sub _get_bottom { | ||||||
231 | 7 | 0 | my ( $self, @list ) = @_; | ||||
232 | |||||||
233 | 7 | 0 | return [] if @list < $self->table_length; | ||||
234 | |||||||
235 | 5 | 0 | @list = reverse @list; | ||||
236 | 5 | 0 | my $slice_end = min( $#list, $self->table_length - 1 ); | ||||
237 | 5 | 0 | my @bottom = @list[ 0 .. $slice_end ]; | ||||
238 | |||||||
239 | 5 | 0 | my $bottom_size = @list - $self->table_length; | ||||
240 | 5 | 0 | @bottom = splice @bottom, 0, $bottom_size if $bottom_size < $self->table_length; | ||||
241 | |||||||
242 | 5 | 0 | return clone \@bottom; | ||||
243 | } | ||||||
244 | |||||||
245 | sub _col_short_name { | ||||||
246 | 98 | 0 | my ( $self, $col ) = @_; | ||||
247 | 98 | 0 | return ucfirst "Code::Statistics::Metric::$col"->short_name; | ||||
248 | } | ||||||
249 | |||||||
250 | 1; | ||||||
251 |