File Coverage

File:lib/Code/Statistics/Collector.pm
Coverage:99.2%

linestmtbrancondsubpodtimecode
1
2
2
2
0
0
0
use strict;
2
2
2
2
0
0
0
use warnings;
3
4package Code::Statistics::Collector;
5
6# ABSTRACT: collects statistics and dumps them to json
7
8
2
2
2
0
0
0
use 5.006_003;
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::SlurpyConstructor;
14
2
2
2
0
0
0
use Code::Statistics::Metric;
15
2
2
2
0
0
0
use Code::Statistics::Target;
16
17
2
2
2
0
0
0
use File::Find::Rule::Perl;
18
2
2
2
0
0
0
use Code::Statistics::File;
19
2
2
2
0
0
0
use JSON 'to_json';
20
2
2
2
0
0
0
use File::Slurp 'write_file';
21
2
2
2
0
0
0
use Term::ProgressBar::Simple;
22
2
2
2
0
0
0
use File::Find::Rule;
23
24has no_dump => ( isa => 'Bool' );
25
26has dirs => (
27    isa => 'CS::InputList',
28    coerce => 1,
29    default => sub { ['.'] },
30);
31
32has files => (
33    isa => 'ArrayRef',
34    lazy => 1,
35    default => sub {
36        return $_[0]->_prepare_files;
37    },
38);
39
40has targets => (
41    isa => 'CS::InputList',
42    coerce => 1,
43    default => sub { $_[0]->_get_all_submodules_for('Target') },
44);
45
46has metrics => (
47    isa => 'CS::InputList',
48    coerce => 1,
49    default => sub { $_[0]->_get_all_submodules_for('Metric') },
50);
51
52has progress_bar => (
53    isa => 'Term::ProgressBar::Simple',
54    lazy => 1,
55    default => sub {
56        my $params = { name => 'Files', ETA => 'linear', max_update_rate => '0.1' };
57        $params->{count} = @{ $_[0]->files };
58        return Term::ProgressBar::Simple->new( $params );
59    },
60);
61
62has command_args => (
63    is => 'ro',
64    slurpy => 1,
65);
66
67 - 70
=head2 collect
    Locates files to collect statistics on, collects them and dumps them to
    JSON.
=cut
71
72sub collect {
73
4
1
0
    my ( $self ) = @_;
74
75
4
4
4
0
0
0
    $_->analyze for @{ $self->files };
76
77
4
0
    my $json = $self->_measurements_as_json;
78
4
0
    $self->_dump_file_measurements( $json );
79
80
4
0
    return $json;
81}
82
83sub _find_files {
84
4
0
    my ( $self ) = @_;
85
4
0
    my @files = (
86
4
0
        File::Find::Rule::Perl->perl_file->in( @{ $self->dirs } ),
87
4
0
        File::Find::Rule->file->name( '*.cgi' )->in( @{ $self->dirs } ),
88    );
89
4
16
0
0
    @files = sort { lc $a cmp lc $b } @files;
90
4
0
    return @files;
91}
92
93sub _prepare_files {
94
4
0
    my ( $self ) = @_;
95
4
0
    my @files = $self->_find_files;
96
4
0
    @files = map $self->_prepare_file( $_ ), @files;
97
4
0
    return \@files;
98}
99
100sub _prepare_file {
101
16
0
    my ( $self, $path ) = @_;
102
103    my %params = (
104        path => $path,
105        original_path => $path,
106        targets => $self->targets,
107        metrics => $self->metrics,
108
16
0
        progress => sub { $self->progress_bar->increment },
109
16
0
    );
110
111
16
16
0
0
    return Code::Statistics::File->new( %params, %{$self->command_args} );
112}
113
114sub _dump_file_measurements {
115
4
0
    my ( $self, $text ) = @_;
116
4
0
    return if $self->no_dump;
117
118
2
0
    write_file( 'codestat.out', $text );
119
120
2
0
    return $self;
121}
122
123sub _measurements_as_json {
124
4
0
    my ( $self ) = @_;
125
126
4
4
0
0
    my @files = map $self->_strip_file( $_ ), @{ $self->files };
127
4
4
0
0
    my @ignored_files = $self->_find_ignored_files( @{ $self->files } );
128
129
4
0
    my $measurements = {
130        files => \@files,
131        targets => $self->targets,
132        metrics => $self->metrics,
133        ignored_files => \@ignored_files
134    };
135
136
4
0
    my $json = to_json( $measurements, { pretty => 1 } );
137
138
4
0
    return $json;
139}
140
141sub _find_ignored_files {
142
4
0
    my ( $self, @files ) = @_;
143
144
4
16
0
0
    my %present_files = map { $_->{original_path} => 1 } @files;
145
146
4
4
0
0
    my @all_files = File::Find::Rule->file->in( @{ $self->dirs } );
147
4
16
0
0
    @all_files = grep { !$present_files{$_} } @all_files;
148
4
0
    my $useless_stuff = qr{
149        (^|/)
150            (
151                [.]git | [.]svn | cover_db | [.]build | nytprof |
152                blib
153            )
154        /
155    }x;
156
4
0
0
0
    @all_files = grep { $_ !~ $useless_stuff } @all_files; # filter out files we most certainly do not care about
157
158
4
0
    return @all_files;
159}
160
161 - 164
=head2 _strip_file
    Cuts down a file hash to have only the keys we actually want to dump to the
    json file.
=cut
165
166sub _strip_file {
167
16
0
    my ( $self, $file ) = @_;
168
16
32
0
0
    my %stripped_file = map { $_ => $file->{$_} } qw( path measurements );
169
16
0
    return \%stripped_file;
170}
171
172sub _get_all_submodules_for {
173
8
0
    my ( $self, $type ) = @_;
174
8
0
    my $class = "Code::Statistics::$type";
175
8
0
    my @list = sort $class->all;
176
177
8
8
31250
0
    $_ =~ s/$class\::// for @list;
178
179
8
0
    my $all = join ';', @list;
180
181
8
0
    return $all;
182}
183
1841;