File Coverage

blib/lib/App/whichpm.pm
Criterion Covered Total %
statement 36 36 100.0
branch 10 10 100.0
condition n/a
subroutine 9 9 100.0
pod 1 1 100.0
total 56 56 100.0


line stmt bran cond sub pod time code
1             package App::whichpm;
2              
3             =head1 NAME
4              
5             App::whichpm - locate a Perl module and it's version
6              
7             =head1 SYNOPSIS
8              
9             use App::whichpm 'which_pm';
10             my ($filename, $version) = which_pm('App::whichpm');
11             my $filename = App::whichpm::find('App::whichpm');
12              
13             from shell:
14              
15             whichpm App::whichpm
16             whichpm Universe::ObservableUniverse::Filament::SuperCluster::Cluster::Group::Galaxy::Arm::Bubble::InterstellarCloud::SolarSystem::Earth
17              
18             =head1 DESCRIPTION
19              
20             Loads a given module and reports it's location and version.
21              
22             The similar function can be achieved via:
23              
24             perldoc -l Some::Module
25             perl -MSome::Module -le 'print $INC{"Some/Module.pm"}'
26             perl -MSome::Module -le 'print Some::Module->VERSION'
27             pmpath Some::Module
28             pmvers Some::Module
29              
30             =cut
31              
32 7     7   447184 use warnings;
  7         14  
  7         379  
33 7     7   641 use strict;
  7         69  
  7         356  
34              
35             our $VERSION = '0.06';
36              
37 7     7   45 use File::Spec;
  7         10  
  7         265  
38              
39 7     7   546 use base 'Exporter';
  6         13  
  6         3701  
40             our @EXPORT_OK = qw(
41             which_pm
42             );
43              
44             =head1 EXPORTS
45              
46             =head2 which_pm
47              
48             same as L only exported under C name.
49              
50             =cut
51              
52             *which_pm = *find;
53              
54             =head1 FUNCTIONS
55              
56             =head2 find($module_name)
57              
58             Loads the C<$module_name>.
59              
60             In scalar context returns filename corresponding to C<$module_name>.
61             In array context returns filename and version.
62              
63             C<$module_name> can be either C or C
64              
65             =cut
66              
67             sub find {
68 14     14 1 308687 my $module_name = shift;
69 13         24 my $module_filename;
70              
71 13 100       66 if ($module_name =~ m/\.pm$/xms) {
72 3         17 $module_name = substr($module_name, 0, -3);
73 3         15 $module_name =~ s{[/\\]}{::}g;
74             }
75              
76 14         53 $module_filename = $module_name.'.pm';
77 14         610 my $module_inc_filename = join('/', split('::', $module_filename));
78 13         203 $module_filename = File::Spec->catfile(split('::', $module_filename));
79              
80 13     5   1576 eval "use $module_name;";
  4     1   954  
  3     1   1516  
  3     1   124  
81 14         100 my $filename = $INC{$module_inc_filename};
82              
83             # if the filename is not in %INC then try to search the @INC folders
84 14 100       50 if (not $filename) {
85 5         34 foreach my $inc_path (@INC) {
86 37         267 my $module_full_filename = File::Spec->catfile($inc_path, $module_filename);
87 37 100       382 return $module_full_filename
88             if -f $module_full_filename;
89             }
90 4         42 return;
91             }
92              
93             # MSWin32 has unix / in the %INC folder paths, so recreate the filename
94 9         216 $filename = File::Spec->catfile(split(m{[/\\]}, $filename));
95              
96 9 100       44 if (wantarray) {
97 5         10 my $version = eval { $module_name->VERSION };
  5         55  
98 5 100       48 return ($filename, (defined $version ? $version : ()));
99             }
100              
101 4         51 return $filename
102             }
103              
104             1;
105              
106              
107             __END__