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 2     2   66111 use strict;
  2         13  
  2         70  
3 2     2   11 use warnings;
  2         4  
  2         60  
4 2     2   10 use File::Find ();
  2         4  
  2         27  
5 2     2   8 use Cwd ();
  2         17  
  2         1238  
6              
7             our $VERSION = "1.001";
8              
9             sub new {
10 1     1 0 1170 my( $class, %params ) = @_;
11 1         7 bless \%params, $class;
12             }
13              
14             sub find {
15 1     1 0 2 my $self = shift;
16 1         3 my (@inc) = @_;
17              
18 1 50       4 @inc = @INC unless @inc;
19 1 50       3 @inc = grep { defined && -d $_ } map { Cwd::realpath($_) } @inc;
  1         21  
  1         40  
20              
21 1         4 my %seen;
22             my @deps;
23 1 50       6 push @deps, { dist => 'perl', version => $] } if $self->{include_perl};
24              
25             File::Find::find(
26             {
27             wanted => sub {
28 5     5   20 my $path = $File::Find::name;
29 5 100 66     541 if ( $path && -f $path && m/\.pm$/ ) {
      66        
30 1 50       4 return unless my $module = module_from_file($path);
31              
32 1 50       19 return unless my $distname = $self->{db}->{module2dist}->{$module};
33              
34 1         2 my $dist = $self->{db}->{dists}->{$distname};
35 1 50       4 if ( $dist->{main_module} eq $module ) {
36 1 50       5 return if $seen{$module}++;
37              
38 1 50       4 return unless my $version = module_version($path);
39              
40 1         6 push @deps, { dist => $distname, version => $version };
41              
42 1 50       49 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         215 follow => 1,
55             follow_skip => 2,
56             },
57             @inc
58             );
59              
60 1         18 return @deps;
61             }
62              
63             sub module_version {
64 1     1 0 435 require Module::Extract::VERSION;
65 1         1559 my( $file ) = @_;
66              
67 1         10 my $version = Module::Extract::VERSION->parse_version_safely( $file );
68              
69 1 50       44018 if( eval { $version->can('numify') } ) {
  1         13  
70 0         0 $version = $version->numify;
71             }
72              
73 1         11 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       41 open my $fh, '<', $path or return;
81 1         38 while ( my $line = <$fh> ) {
82 9 100       31 if ( $line =~ m/package\s+(.*?)\s*;/ms ) {
83 1         5 $module = $1;
84 1         2 last;
85             }
86             }
87 1         15 close $fh;
88              
89 1 50       9 return unless $module;
90             }
91              
92             1;