File Coverage

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

linestmtbrancondsubpodtimecode
1
2
2
2
0
0
0
use strict;
2
2
2
2
0
0
0
use warnings;
3
4package 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
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
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
70sub _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
82sub _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
101sub _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
120sub _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
128sub _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
152sub _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
169sub _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
178sub _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
1931;
194