File Coverage

blib/lib/CPAN/Audit/Installed.pm
Criterion Covered Total %
statement 50 51 98.0
branch 22 28 78.5
condition 5 6 83.3
subroutine 9 9 100.0
pod 0 4 0.0
total 86 98 87.7


line stmt bran cond sub pod time code
1             package CPAN::Audit::Installed;
2 14     14   86911 use strict;
  14         26  
  14         639  
3 14     14   76 use warnings;
  14         26  
  14         1161  
4 14     14   80 use File::Find ();
  14         58  
  14         241  
5 14     14   101 use Cwd ();
  14         26  
  14         10409  
6              
7             our $VERSION = "1.001";
8              
9             sub new {
10 3     3 0 154790 my( $class, %params ) = @_;
11 3         23 bless \%params, $class;
12             }
13              
14             sub find {
15 3     3 0 8 my $self = shift;
16 3         13 my (@inc) = @_;
17              
18 3 100       19 @inc = @INC unless @inc;
19 3 50       7 @inc = grep { defined && -d $_ } map { Cwd::realpath($_) } @inc;
  19         163  
  19         676  
20              
21 3         13 my %seen;
22             my @deps;
23 3 50       21 push @deps, { dist => 'perl', version => $] } if $self->{include_perl};
24              
25             File::Find::find(
26             {
27             wanted => sub {
28 24507     24507   70518 my $path = $File::Find::name;
29 24507 100 66     2023899 if ( $path && -f $path && m/\.pm$/ ) {
      100        
30 3233 100       11978 return unless my $module = module_from_file($path);
31              
32 3207 100       183442 return unless my $distname = $self->{db}->{module2dist}->{$module};
33              
34 691         2319 my $dist = $self->{db}->{dists}->{$distname};
35 691 100       42344 if ( $dist->{main_module} eq $module ) {
36 89 50       556 return if $seen{$module}++;
37              
38 89 50       343 return unless my $version = module_version($path);
39              
40 89         554 push @deps, { dist => $distname, version => $version };
41              
42 89 100       3376 if ( $self->{cb} ) {
43 44         388 $self->{cb}->(
44             {
45             path => $path,
46             distname => $distname,
47             version => $version
48             }
49             );
50             }
51             }
52             }
53             },
54 3         481 follow => 1,
55             follow_skip => 2,
56             },
57             @inc
58             );
59              
60 3         118 return @deps;
61             }
62              
63             sub module_version {
64 89     89 0 2449 require Module::Extract::VERSION;
65 89         3543 my( $file ) = @_;
66              
67 89         927 my $version = Module::Extract::VERSION->parse_version_safely( $file );
68              
69 89 50       373891 if( eval { $version->can('numify') } ) {
  89         999  
70 0         0 $version = $version->numify;
71             }
72              
73 89         531 return "$version";
74             }
75              
76             sub module_from_file {
77 3233     3233 0 7813 my ($path) = @_;
78 3233         5041 my $module;
79              
80 3233 50       131047 open my $fh, '<', $path or return;
81 3233         82966 while ( my $line = <$fh> ) {
82 24355 100       98130 if ( $line =~ m/package\s+(.*?)\s*;/ms ) {
83 3207         10935 $module = $1;
84 3207         7365 last;
85             }
86             }
87 3233         47762 close $fh;
88              
89 3233 100       26509 return unless $module;
90             }
91              
92             1;