File Coverage

blib/lib/Module/Which.pm
Criterion Covered Total %
statement 38 46 82.6
branch 6 14 42.8
condition n/a
subroutine 9 10 90.0
pod 2 4 50.0
total 55 74 74.3


line stmt bran cond sub pod time code
1             package Module::Which;
2             $Module::Which::VERSION = '0.04';
3 1     1   40768 use 5.006;
  1         4  
  1         44  
4 1     1   7 use strict;
  1         1  
  1         39  
5 1     1   6 use warnings;
  1         8  
  1         86  
6              
7             require Exporter;
8              
9             our @ISA = qw( Exporter );
10             our @EXPORT = qw( which );
11              
12             #use Module::Find;
13 1     1   697 use Module::Which::List qw(list_pm_files);
  1         2  
  1         60  
14 1     1   639 use Data::Hash::Transform qw(hash_em);
  1         3  
  1         85  
15              
16             #sub pm_require {
17             # my $pm = shift;
18             # my $verbose = shift;
19             # eval "require $pm";
20             # if ($@) { # error
21             # warn "'require $pm' failed: $@" if $verbose;
22             # return (0, $@);
23             # }
24             # return 1
25             #}
26              
27             #sub pm_version {
28             # my $pm = shift;
29             # no strict 'refs';
30             # return ${"${pm}::VERSION"};
31             #}
32              
33 1     1   2032 use ExtUtils::MakeMaker;
  1         207074  
  1         818  
34              
35             =begin private
36              
37             =item B
38              
39             $v = pm_version($pm);
40              
41             Parses a PM file and return what it thinks is $VERSION
42             in this file. (Actually implemented with
43             Cparse_version($file)>.)
44             C<$pm> is the filename (eg., F).
45              
46             =end private
47              
48             =cut
49             sub pm_version {
50 4     4 1 7 my $pm = shift;
51 4         5 my $v;
52 4         6 eval { $v = MM->parse_version($pm); };
  4         42  
53 4 50       5228 return $@ ? undef : $v;
54             }
55              
56             sub pm_info {
57 4     4 0 5 my $pm = shift; # --- { pm: (pm), path: (path), base: (base), }
58 4         6 my $options = shift;
59              
60 4         14 my $version = pm_version($pm->{path});
61              
62             return {
63 4         42 version => $version,
64             pm => $pm->{pm},
65             path => $pm->{path},
66             base => $pm->{base}
67             };
68             }
69              
70             #sub is_wildcard {
71             # return shift =~ /::\*$/;
72             #}
73              
74             #sub expand_wildcard {
75             # my $wildcard = shift;
76             # $wildcard =~ s/::\*$//;
77             # return findallmod $wildcard;
78             #}
79              
80             # turns an array of hashes to a hash of hashes
81             sub hashify (\@$) {
82 0     0 0 0 my ($ary, $opt_meth) = @_;
83 0         0 our %meth = ( 'HASH' => 'f', 'HASH(FIRST)' => 'f', 'HASH(MULTI)' => 'm', 'HASH(LIST)' => 'a' );
84 0 0       0 my $meth = $meth{$opt_meth}
85             or die "hash strategy '$opt_meth' unknown";
86 0         0 return hash_em($ary, 'pm', $meth);
87             }
88              
89              
90             # which(@pm)
91             # which(@pm, $options) where $options is a hash ref
92             sub which {
93 1     1 1 16 my $options = {};
94 1 50       5 $options = pop @_ if ref $_[-1];
95 1 50       5 $options->{return} = 'HASH' unless $options->{return};
96              
97 1         3 my @pm = @_;
98              
99 1         66 my @info;
100 1         4 for my $pm (@pm) {
101              
102             # special case: 'perl'
103 4 50       16 if ( $pm eq 'perl' ) {
104 0         0 push @info, {
105             pm => 'perl',
106             version => sprintf("%vd", $^V), #$],
107             path => $^X,
108             base => '', # XXX ?!
109             };
110 0         0 next;
111             }
112              
113             #push @info, pm_info($_, $options) for list_pm_files($pm, recurse => 1);
114              
115 4         25 my @pm_files = list_pm_files($pm, recurse => 1, include => $options->{include});
116 4 50       14 if (@pm_files) {
117 4         16 push @info, pm_info($_, $options) for @pm_files;
118             } else {
119 0         0 push @info, { pm => $pm };
120             }
121              
122             #if (is_wildcard($pm)) {
123             # push @info, pm_info($_, $options) for expand_wildcard($pm);
124             #} else {
125             # push @info, pm_info($pm, $options);
126             #}
127             }
128 1 50       10 return \@info if $options->{return} eq 'ARRAY';
129              
130 0           return hashify(@info, $options->{return});
131             }
132              
133             1;
134              
135             __END__