File: | lib/Code/Statistics/Reporter.pm |
Coverage: | 96.8% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | 2 2 2 | 0 0 0 | use strict; | ||||
2 | 2 2 2 | 0 0 0 | use warnings; | ||||
3 | |||||||
4 | package Code::Statistics::Reporter; | ||||||
5 | |||||||
6 | # ABSTRACT: creates reports statistics and outputs them | ||||||
7 | |||||||
8 | 2 2 2 | 0 0 0 | use 5.004; | ||||
9 | |||||||
10 | 2 2 2 | 0 0 0 | use Moose; | ||||
11 | 2 2 2 | 0 0 0 | use MooseX::HasDefaults::RO; | ||||
12 | 2 2 2 | 0 0 0 | use Code::Statistics::MooseTypes; | ||||
13 | 2 2 2 | 0 0 0 | use Code::Statistics::Metric; | ||||
14 | |||||||
15 | 2 2 2 | 0 0 0 | use Carp 'confess'; | ||||
16 | 2 2 2 | 0 0 0 | use JSON 'from_json'; | ||||
17 | 2 2 2 | 0 0 0 | use File::Slurp 'read_file'; | ||||
18 | 2 2 2 | 0 0 0 | use List::Util qw( reduce max sum ); | ||||
19 | 2 2 2 | 0 0 0 | use Data::Section -setup; | ||||
20 | 2 2 2 | 0 0 0 | use Template; | ||||
21 | 2 2 2 | 0 0 0 | use List::MoreUtils qw( uniq ); | ||||
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 | 2 | 1 | 0 | my ( $self ) = @_; | |||
41 | |||||||
42 | 2 | 0 | my $stats = from_json read_file('codestat.out'); | ||||
43 | |||||||
44 | 2 2 | 0 0 | $stats->{files} = $self->_strip_ignored_files( @{ $stats->{files} } ); | ||||
45 | 2 | 0 | $stats->{target_types} = $self->_prepare_target_types( $stats->{files} ); | ||||
46 | |||||||
47 | 2 2 2 | 0 0 0 | $_->{metrics} = $self->_process_target_type( $_, $stats->{metrics} ) for @{$stats->{target_types}}; | ||||
48 | |||||||
49 | 2 | 0 | my $output; | ||||
50 | 2 | 0 | my $tmpl = $self->section_data( 'dos_template' ); | ||||
51 | 2 | 0 | my $tt = Template->new( STRICT => 1 ); | ||||
52 | $tt->process( | ||||||
53 | $tmpl, | ||||||
54 | { | ||||||
55 | targets => $stats->{target_types}, | ||||||
56 | truncate_front => sub { | ||||||
57 | 184 | 0 | my ( $string, $length ) = @_; | ||||
58 | 184 | 0 | return $string if $length >= length $string; | ||||
59 | 0 | 0 | return substr $string, 0-$length, $length; | ||||
60 | }, | ||||||
61 | }, | ||||||
62 | 2 | 0 | \$output | ||||
63 | ) or confess $tt->error; | ||||||
64 | |||||||
65 | 2 | 0 | print $output if !$self->quiet; | ||||
66 | |||||||
67 | 2 | 0 | return $output; | ||||
68 | } | ||||||
69 | |||||||
70 | sub _strip_ignored_files { | ||||||
71 | 2 | 0 | my ( $self, @files ) = @_; | ||||
72 | |||||||
73 | 2 4 2 | 0 0 0 | my @ignore_regexes = grep { $_ } @{ $self->file_ignore }; | ||||
74 | |||||||
75 | 2 | 0 | for my $re ( @ignore_regexes ) { | ||||
76 | 2 8 | 0 0 | @files = grep { $_->{path} !~ $re } @files; | ||||
77 | } | ||||||
78 | |||||||
79 | 2 | 0 | return \@files; | ||||
80 | } | ||||||
81 | |||||||
82 | sub _sort_columns { | ||||||
83 | 18 | 0 | my ( $self, %widths ) = @_; | ||||
84 | |||||||
85 | 18 162 | 0 0 | my @columns = uniq grep { $widths{$_} } qw( path line col ), keys %widths; | ||||
86 | |||||||
87 | 18 108 | 0 0 | @columns = map {{ name => $_, width => $widths{$_} }} @columns; | ||||
88 | |||||||
89 | 18 | 0 | my $used_width = sum( values %widths ) - $columns[0]{width}; | ||||
90 | 18 | 0 | my $path_width = $self->screen_width - $used_width; | ||||
91 | 18 | 0 | $columns[0]{width} = max( $self->min_path_width, $path_width ); | ||||
92 | |||||||
93 | 18 | 0 | for ( @columns ) { | ||||
94 | 108 | 0 | $_->{printname} = ucfirst "Code::Statistics::Metric::$_->{name}"->column_name; | ||||
95 | 108 | 0 | $_->{printname} = " $_->{printname}" if $_->{name} ne 'path'; | ||||
96 | } | ||||||
97 | |||||||
98 | 18 | 0 | return \@columns; | ||||
99 | } | ||||||
100 | |||||||
101 | sub _prepare_target_types { | ||||||
102 | 2 | 0 | my ( $self, $files ) = @_; | ||||
103 | |||||||
104 | 2 | 0 | my %target_types; | ||||
105 | |||||||
106 | 2 2 | 0 0 | for my $file ( @{$files} ) { | ||||
107 | 6 6 | 0 0 | for my $target_type ( keys %{$file->{measurements}} ) { | ||||
108 | 14 14 | 0 0 | for my $target ( @{$file->{measurements}{$target_type}} ) { | ||||
109 | 74 | 0 | $target->{path} = $file->{path}; | ||||
110 | 74 74 | 0 0 | push @{ $target_types{$target_type}->{list} }, $target; | ||||
111 | } | ||||||
112 | } | ||||||
113 | } | ||||||
114 | |||||||
115 | 2 2 | 0 0 | $target_types{$_}->{type} = $_ for keys %target_types; | ||||
116 | |||||||
117 | 2 | 0 | return [ values %target_types ]; | ||||
118 | } | ||||||
119 | |||||||
120 | sub _process_target_type { | ||||||
121 | 6 | 0 | my ( $self, $target_type, $metrics ) = @_; | ||||
122 | |||||||
123 | 6 6 | 0 0 | my @metric = map $self->_process_metric( $target_type, $_ ), @{$metrics}; | ||||
124 | |||||||
125 | 6 | 0 | return \@metric; | ||||
126 | } | ||||||
127 | |||||||
128 | sub _process_metric { | ||||||
129 | 36 | 0 | my ( $self, $target_type, $metric ) = @_; | ||||
130 | |||||||
131 | 36 | 0 | return if !"Code::Statistics::Metric::$metric"->is_significant; | ||||
132 | 18 | 0 | return if !$target_type->{list}[0]; | ||||
133 | 18 | 0 | return if !exists $target_type->{list}[0]{$metric}; | ||||
134 | |||||||
135 | 18 558 18 | 0 15625 0 | my @list = reverse sort { $a->{$metric} <=> $b->{$metric} } @{$target_type->{list}}; | ||||
136 | 18 180 | 0 0 | my @top = grep { defined } @list[ 0 .. $self->table_length - 1 ]; | ||||
137 | 18 264 | 0 0 | @list = grep { defined } @list; # the above autovivifies some entries, this reverses that | ||||
138 | |||||||
139 | 18 | 0 | my $metric_data = { | ||||
140 | top => \@top, | ||||||
141 | type => $metric, | ||||||
142 | }; | ||||||
143 | |||||||
144 | 18 | 0 | $metric_data->{bottom} = $self->_get_bottom( @list ); | ||||
145 | 18 | 0 | $metric_data->{avg} = $self->_calc_average( $metric, @list ); | ||||
146 | 18 18 | 0 0 | $metric_data->{widths} = $self->_calc_widths( @{$metric_data->{bottom}}, @top ); | ||||
147 | 18 18 | 0 0 | $metric_data->{columns} = $self->_sort_columns( %{ $metric_data->{widths} } ); | ||||
148 | |||||||
149 | 18 | 0 | return $metric_data; | ||||
150 | } | ||||||
151 | |||||||
152 | sub _calc_widths { | ||||||
153 | 18 | 0 | my ( $self, $bottom, @list ) = @_; | ||||
154 | |||||||
155 | 18 18 | 0 0 | my @columns = keys %{$list[0]}; | ||||
156 | |||||||
157 | 18 | 0 | my %widths; | ||||
158 | 18 | 0 | for my $col ( @columns ) { | ||||
159 | 108 1296 | 0 15625 | my @lengths = map { length $_->{$col} } @list, { $col => $col }; | ||||
160 | 108 | 0 | my $max = max @lengths; | ||||
161 | 108 | 0 | $widths{$col} = $max; | ||||
162 | } | ||||||
163 | |||||||
164 | 18 18 | 0 0 | $_++ for values %widths; | ||||
165 | |||||||
166 | 18 | 0 | return \%widths; | ||||
167 | } | ||||||
168 | |||||||
169 | sub _calc_average { | ||||||
170 | 18 | 0 | my ( $self, $metric, @list ) = @_; | ||||
171 | |||||||
172 | 18 222 | 0 0 | my $sum = reduce { $a + $b->{$metric} } 0, @list; | ||||
173 | 18 | 0 | my $average = $sum / @list; | ||||
174 | |||||||
175 | 18 | 0 | return $average; | ||||
176 | } | ||||||
177 | |||||||
178 | sub _get_bottom { | ||||||
179 | 18 | 0 | my ( $self, @list ) = @_; | ||||
180 | |||||||
181 | 18 | 0 | return [] if @list < $self->table_length; | ||||
182 | |||||||
183 | 12 | 0 | @list = reverse @list; | ||||
184 | 12 | 0 | my @bottom = @list[ 0 .. $self->table_length - 1 ]; | ||||
185 | 12 204 | 0 0 | @list = grep { defined } @list; # the above autovivifies some entries, this reverses that | ||||
186 | |||||||
187 | 12 | 0 | my $bottom_size = @list - $self->table_length; | ||||
188 | 12 | 0 | @bottom = splice @bottom, 0, $bottom_size if $bottom_size < $self->table_length; | ||||
189 | |||||||
190 | 12 | 0 | return \@bottom; | ||||
191 | } | ||||||
192 | |||||||
193 | 1; | ||||||
194 |