File Coverage

blib/lib/CPAN/Audit/Installed.pm
Criterion Covered Total %
statement 49 51 96.0
branch 16 28 57.1
condition 4 6 66.6
subroutine 9 9 100.0
pod 0 4 0.0
total 78 98 79.5


line stmt bran cond sub pod time code
1             package CPAN::Audit::Installed;
2 3     3   70158 use strict;
  3         14  
  3         117  
3 3     3   16 use warnings;
  3         6  
  3         100  
4 3     3   15 use File::Find ();
  3         6  
  3         37  
5 3     3   19 use Cwd ();
  3         33  
  3         1795  
6              
7             our $VERSION = "1.001";
8              
9             sub new {
10 1     1 0 1223 my( $class, %params ) = @_;
11 1         15 bless \%params, $class;
12             }
13              
14             sub find {
15 1     1 0 2 my $self = shift;
16 1         4 my (@inc) = @_;
17              
18 1 50       4 @inc = @INC unless @inc;
19 1 50       4 @inc = grep { defined && -d $_ } map { Cwd::realpath($_) } @inc;
  1         21  
  1         42  
20              
21 1         3 my %seen;
22             my @deps;
23 1 50       7 push @deps, { dist => 'perl', version => $] } if $self->{include_perl};
24              
25             File::Find::find(
26             {
27             wanted => sub {
28 5     5   21 my $path = $File::Find::name;
29 5 100 66     587 if ( $path && -f $path && m/\.pm$/ ) {
      66        
30 1 50       5 return unless my $module = module_from_file($path);
31              
32 1 50       17 return unless my $distname = $self->{db}->{module2dist}->{$module};
33              
34 1         3 my $dist = $self->{db}->{dists}->{$distname};
35 1 50       4 if ( $dist->{main_module} eq $module ) {
36 1 50       4 return if $seen{$module}++;
37              
38 1 50       4 return unless my $version = module_version($path);
39              
40 1         5 push @deps, { dist => $distname, version => $version };
41              
42 1 50       52 if ( $self->{cb} ) {
43 0         0 $self->{cb}->(
44             {
45             path => $path,
46             distname => $distname,
47             version => $version
48             }
49             );
50             }
51             }
52             }
53             },
54 1         200 follow => 1,
55             follow_skip => 2,
56             },
57             @inc
58             );
59              
60 1         19 return @deps;
61             }
62              
63             sub module_version {
64 1     1 0 520 require Module::Extract::VERSION;
65 1         1575 my( $file ) = @_;
66              
67 1         10 my $version = Module::Extract::VERSION->parse_version_safely( $file );
68              
69 1 50       43766 if( eval { $version->can('numify') } ) {
  1         12  
70 0         0 $version = $version->numify;
71             }
72              
73 1         5 return "$version";
74             }
75              
76             sub module_from_file {
77 1     1 0 3 my ($path) = @_;
78 1         2 my $module;
79              
80 1 50       49 open my $fh, '<', $path or return;
81 1         35 while ( my $line = <$fh> ) {
82 9 100       31 if ( $line =~ m/package\s+(.*?)\s*;/ms ) {
83 1         4 $module = $1;
84 1         3 last;
85             }
86             }
87 1         15 close $fh;
88              
89 1 50       10 return unless $module;
90             }
91              
92             1;