File Coverage

blib/lib/Module/Which/List.pm
Criterion Covered Total %
statement 50 68 73.5
branch 8 22 36.3
condition 0 3 0.0
subroutine 10 12 83.3
pod 0 4 0.0
total 68 109 62.3


line stmt bran cond sub pod time code
1              
2             package Module::Which::List;
3             $Module::Which::List::VERSION = '0.04';
4 1     1   18 use 5.006;
  1         3  
  1         90  
5 1     1   6 use strict;
  1         1  
  1         29  
6 1     1   5 use warnings;
  1         1  
  1         153  
7              
8             require Exporter;
9              
10             our @ISA = qw(Exporter);
11             our @EXPORT_OK = qw(list_pm_files);
12              
13 1     1   6 use File::Glob qw(bsd_glob);
  1         2  
  1         147  
14             #use File::Spec::Functions qw(abs2rel);
15             require File::Spec::Unix;
16 1     1   5 use File::Find qw(find);
  1         3  
  1         974  
17              
18             # returns a list with no duplicates
19             sub uniq {
20 4     4 0 5 my %h;
21 4         6 return grep { ! $h{$_}++ } @_;
  40         118  
22             }
23              
24              
25             # my @files = _plain_list_files('File/*', @INC);
26             sub _plain_list_files {
27 4     4   6 my $glob = shift;
28 4         9 my @INC = @_;
29 4         4 my @files;
30             #push @files, bsd_glob("$_/$glob") for @INC;
31 4         7 for my $base (@INC) {
32             #print "bsd_glob($_/$glob)\n";
33 4         324 push @files,
34 40         727 map { { path => $_, rpath => File::Spec::Unix->abs2rel($_, $base), base => $base } }
35 40         1244 grep { -e } bsd_glob("$base/$glob")
36             }
37              
38 4 50       31 return @files if wantarray;
39 0         0 return \@files;
40             }
41              
42             # my @files = _deep_list_files('Data/**.pm', @INC)
43             sub _deep_list_files {
44 0     0   0 my $glob = shift;
45 0         0 my @INC = @_;
46              
47             #print "deep_list_files: ...\n";
48              
49 0         0 my $root = $glob;
50 0         0 $root =~ s/\*\*\.pm$//;
51              
52 0         0 my $base;
53             my @files;
54              
55             my $wanted = sub {
56 0 0   0   0 if (/\.pm$/) {
57 0         0 push @files, { path => $_, rpath => File::Spec::Unix->abs2rel($_, $base), base => $base };
58             }
59 0         0 };
60              
61 0         0 for (@INC) {
62 0         0 $base = $_;
63 0 0 0     0 if (-e "$base/$root" && -d "$base/$root") {
64 0         0 find({ wanted => $wanted, no_chdir => 1 }, "$base/$root");
65             }
66             }
67              
68 0 0       0 return @files if wantarray;
69 0         0 return \@files;
70              
71             }
72              
73             sub list_files {
74 4     4 0 7 my $glob = shift;
75 4         13 my %options = @_;
76 4         5 my @include;
77 4 50       26 @include = ($options{include}) ? @{$options{include}} : @INC;
  0         0  
78 4 50       22 @include = uniq @include
    50          
79             if exists $options{uniq} ? $options{uniq} : 1; # FIXME: need documentation !!!!
80             #print "include: @include\n";
81 4         9 my @files;
82 4 50       10 if ($glob =~ /\*\*\.pm$/) {
83 0         0 return _deep_list_files($glob, @include);
84             } else {
85 4         12 return _plain_list_files($glob, @include);
86             }
87             }
88              
89             sub file_to_pm {
90 4     4 0 268 my $rpath = shift;
91 4         20 $rpath =~ s|\.pm$||;
92 4         9 $rpath =~ s|/|::|g;
93 4         23 return $rpath;
94             }
95              
96             sub list_pm_files {
97 4     4 0 30 my $pm_glob = shift;
98 4         38 my %options = @_;
99              
100 4         8 my $glob = $pm_glob;
101 4 50       13 $glob =~ s|::$|::*| unless $options{recurse};
102 4 50       13 $glob =~ s|::$|::**| if $options{recurse};
103 4         10 $glob =~ s|::|/|g;
104 4         17 $glob =~ s|$|.pm|;
105             #print "glob: $glob\n";
106              
107 4         21 my @pm_files = list_files($glob, @_);
108            
109 4         8 my @pm;
110 4         6 for (@pm_files) {
111 4         13 push @pm, {
112             pm => file_to_pm($_->{rpath}),
113             path => $_->{path},
114             base => $_->{base}
115             };
116             }
117              
118 4 50       29 return @pm if wantarray;
119 0           return \@pm;
120              
121             }
122              
123             1;
124              
125             __END__