File Coverage

File:lib/Code/Statistics/Reporter.pm
Coverage:96.4%

linestmtbrancondsubpodtimecode
1
1
1
1
0
0
0
use strict;
2
1
1
1
0
0
0
use warnings;
3
4package 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
23has quiet => ( isa => 'Bool' );
24
25has file_ignore => (
26    isa => 'CS::InputList',
27    coerce => 1,
28    default => sub {[]},
29);
30
31has screen_width => ( isa => 'Int', default => 80 );
32has min_path_width => ( isa => 'Int', default => 12 );
33has 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
39sub 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
70sub _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
82sub _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
109sub _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
122sub _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
141sub _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
149sub _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
167sub _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
179sub _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
191sub _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
212sub _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
221sub _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
230sub _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
245sub _col_short_name {
246
98
0
    my ( $self, $col ) = @_;
247
98
0
    return ucfirst "Code::Statistics::Metric::$col"->short_name;
248}
249
2501;
251