| 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 | |||||||