line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Perl::Metrics::Lite::FileFinder; |
2
|
4
|
|
|
4
|
|
28
|
use strict; |
|
4
|
|
|
|
|
10
|
|
|
4
|
|
|
|
|
119
|
|
3
|
4
|
|
|
4
|
|
20
|
use warnings; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
109
|
|
4
|
4
|
|
|
4
|
|
28
|
use Carp qw(cluck confess); |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
231
|
|
5
|
4
|
|
|
4
|
|
1107
|
use English qw(-no_match_vars); |
|
4
|
|
|
|
|
8707
|
|
|
4
|
|
|
|
|
28
|
|
6
|
4
|
|
|
4
|
|
1593
|
use File::Basename qw(fileparse); |
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
273
|
|
7
|
4
|
|
|
4
|
|
26
|
use File::Find qw(find); |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
317
|
|
8
|
4
|
|
|
4
|
|
1946
|
use IO::File; |
|
4
|
|
|
|
|
33912
|
|
|
4
|
|
|
|
|
461
|
|
9
|
4
|
|
|
4
|
|
1111
|
use Readonly; |
|
4
|
|
|
|
|
7691
|
|
|
4
|
|
|
|
|
2818
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
Readonly::Scalar our $PERL_FILE_SUFFIXES => qr{ \. (:? pl | pm | t ) }sxmi; |
12
|
|
|
|
|
|
|
Readonly::Scalar our $SKIP_LIST_REGEX => |
13
|
|
|
|
|
|
|
qr{ \.svn | \. git | _darcs | CVS }sxmi; |
14
|
|
|
|
|
|
|
Readonly::Scalar my $PERL_SHEBANG_REGEX => qr/ \A [#] ! .* perl /sxm; |
15
|
|
|
|
|
|
|
Readonly::Scalar my $DOT_FILE_REGEX => qr/ \A [.] /sxm; |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
sub new { |
18
|
7
|
|
|
7
|
0
|
50
|
my ( $class, %args ) = @_; |
19
|
7
|
|
|
|
|
21
|
my $self = bless( {}, $class ); |
20
|
7
|
|
|
|
|
23
|
return $self; |
21
|
|
|
|
|
|
|
} |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
sub find_files { |
24
|
7
|
|
|
7
|
1
|
38
|
my ( $self, @directories_and_files ) = @_; |
25
|
7
|
|
|
|
|
21
|
foreach my $path (@directories_and_files) { |
26
|
7
|
100
|
|
|
|
204
|
if ( !-r $path ) { |
27
|
1
|
|
|
|
|
236
|
confess "Path '$path' is not readable!"; |
28
|
|
|
|
|
|
|
} |
29
|
|
|
|
|
|
|
} |
30
|
6
|
|
|
|
|
34
|
my @found = $self->list_perl_files(@directories_and_files); |
31
|
6
|
|
|
|
|
29
|
return \@found; |
32
|
|
|
|
|
|
|
} |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
sub list_perl_files { |
35
|
6
|
|
|
6
|
1
|
19
|
my ( $self, @paths ) = @_; |
36
|
6
|
|
|
|
|
13
|
my @files; |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
my $wanted = sub { |
39
|
36
|
50
|
|
36
|
|
137
|
return if $self->should_be_skipped($File::Find::name); |
40
|
36
|
100
|
|
|
|
93
|
if ( $self->is_perl_file($File::Find::name) ) { |
41
|
18
|
|
|
|
|
285
|
push @files, $File::Find::name; ## no critic (ProhibitPackageVars) |
42
|
|
|
|
|
|
|
} |
43
|
6
|
|
|
|
|
35
|
}; |
44
|
|
|
|
|
|
|
|
45
|
6
|
|
|
|
|
649
|
File::Find::find( { wanted => $wanted, no_chdir => 1 }, @paths ); |
46
|
|
|
|
|
|
|
|
47
|
6
|
|
|
|
|
48
|
my @sorted_list = sort @files; |
48
|
6
|
|
|
|
|
43
|
return @sorted_list; |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
sub should_be_skipped { |
52
|
39
|
|
|
39
|
0
|
101
|
my ( $self, $fullpath ) = @_; |
53
|
39
|
|
|
|
|
581
|
my ( $name, $path, $suffix ) = File::Basename::fileparse($fullpath); |
54
|
39
|
|
|
|
|
387
|
return $path =~ $SKIP_LIST_REGEX; |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
sub is_perl_file { |
58
|
36
|
|
|
36
|
1
|
73
|
my ( $self, $path ) = @_; |
59
|
36
|
100
|
|
|
|
1895
|
return if ( !-f $path ); |
60
|
21
|
|
|
|
|
722
|
my ( $name, $path_part, $suffix ) |
61
|
|
|
|
|
|
|
= File::Basename::fileparse( $path, $PERL_FILE_SUFFIXES ); |
62
|
21
|
50
|
|
|
|
203
|
return if $name =~ $DOT_FILE_REGEX; |
63
|
21
|
100
|
|
|
|
58
|
if ( length $suffix ) { |
64
|
15
|
|
|
|
|
51
|
return 1; |
65
|
|
|
|
|
|
|
} |
66
|
6
|
|
|
|
|
21
|
return _has_perl_shebang($path); |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
sub _has_perl_shebang { |
70
|
6
|
|
|
6
|
|
16
|
my $path = shift; |
71
|
|
|
|
|
|
|
|
72
|
6
|
|
|
|
|
46
|
my $fh = IO::File->new( $path, '<' ); |
73
|
6
|
50
|
|
|
|
717
|
if ( !-r $fh ) { |
74
|
0
|
|
|
|
|
0
|
cluck "Could not open '$path' for reading: $OS_ERROR"; |
75
|
0
|
|
|
|
|
0
|
return; |
76
|
|
|
|
|
|
|
} |
77
|
6
|
|
|
|
|
122
|
my $first_line = <$fh>; |
78
|
6
|
|
|
|
|
50
|
$fh->close(); |
79
|
6
|
50
|
|
|
|
126
|
return if ( !$first_line ); |
80
|
6
|
|
|
|
|
134
|
return $first_line =~ $PERL_SHEBANG_REGEX; |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
1; |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
__END__ |