line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Mojolicious::Command::listdeps; |
2
|
|
|
|
|
|
|
##---------------------------------------------------------------------------- |
3
|
|
|
|
|
|
|
## :mode=perl:indentSize=2:tabSize=2:noTabs=true: |
4
|
|
|
|
|
|
|
##**************************************************************************** |
5
|
|
|
|
|
|
|
## NOTES: |
6
|
|
|
|
|
|
|
## * Intent is to have perl critic to complete with no errors when run |
7
|
|
|
|
|
|
|
## at the HARSH (3) level |
8
|
|
|
|
|
|
|
##**************************************************************************** |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
=head1 NAME |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
Mojolicious::Command::listdeps - Command to list dependencies for a |
13
|
|
|
|
|
|
|
Mojolicious project |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=head1 DESCRIPTION |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
L lists all module dependencies, and |
18
|
|
|
|
|
|
|
is typically invoked from the command line in the root of your |
19
|
|
|
|
|
|
|
L project |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
=head1 SYNOPSIS |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
use Mojolicious::Command::listdeps; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
my $command = Mojolicious::Command::listdeps->new; |
26
|
|
|
|
|
|
|
$command->run(@ARGV); |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
=cut |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
##**************************************************************************** |
31
|
|
|
|
|
|
|
##**************************************************************************** |
32
|
1
|
|
|
1
|
|
960
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
38
|
|
33
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
35
|
|
34
|
1
|
|
|
1
|
|
12
|
use Mojo::Base 'Mojolicious::Command'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
9
|
|
35
|
1
|
|
|
1
|
|
313929
|
use File::Find; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
60
|
|
36
|
1
|
|
|
1
|
|
6
|
use File::Spec; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
441
|
|
37
|
1
|
|
|
1
|
|
3623
|
use Module::CoreList; |
|
1
|
|
|
|
|
54521
|
|
|
1
|
|
|
|
|
13
|
|
38
|
1
|
|
|
1
|
|
657
|
use Cwd qw(abs_path); |
|
1
|
|
|
|
|
52
|
|
|
1
|
|
|
|
|
96
|
|
39
|
1
|
|
|
1
|
|
1519
|
use Getopt::Long qw(GetOptions :config pass_through); |
|
1
|
|
|
|
|
13310
|
|
|
1
|
|
|
|
|
7
|
|
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
our $VERSION = "0.06"; |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
##**************************************************************************** |
44
|
|
|
|
|
|
|
## Object attributes |
45
|
|
|
|
|
|
|
##**************************************************************************** |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
=head1 ATTRIBUTES |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
L inherits the following attributes |
50
|
|
|
|
|
|
|
from L |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=cut |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
##------------------------------------------------------------ |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
=head2 C |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
Short description displayed in the "mojo" command list |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
=cut |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
##------------------------------------------------------------ |
63
|
|
|
|
|
|
|
has description => qq{List module dependencies.\n}; |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
##------------------------------------------------------------ |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
=head2 C |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
Displayed in response to mojo help listdeps |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=cut |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
##------------------------------------------------------------ |
74
|
|
|
|
|
|
|
has usage => << "EOF"; |
75
|
|
|
|
|
|
|
usage: $0 listdeps [OPTIONS] |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
Parses all files found in the current directory and below and |
78
|
|
|
|
|
|
|
prints the names of perl modules used in those files. |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
These options are available: |
81
|
|
|
|
|
|
|
--include-tests Include dependencies required for tests |
82
|
|
|
|
|
|
|
--missing Only list missing modules |
83
|
|
|
|
|
|
|
--skip-lib Do not list modules found in ./lib as a dependency |
84
|
|
|
|
|
|
|
--verbose List additional information |
85
|
|
|
|
|
|
|
--core Include core modules in list |
86
|
|
|
|
|
|
|
EOF |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
##----------------------------------------- |
89
|
|
|
|
|
|
|
## Module variables |
90
|
|
|
|
|
|
|
##----------------------------------------- |
91
|
|
|
|
|
|
|
my $include_tests = 0; ## Scan test modules also |
92
|
|
|
|
|
|
|
my $missing_only = 0; ## Display only missing modules |
93
|
|
|
|
|
|
|
my $verbose = 0; ## Extra verbage |
94
|
|
|
|
|
|
|
my $skip_core = 1; ## Skip core modules |
95
|
|
|
|
|
|
|
my $skip_lib = 0; ## Skip modules found in ./lib |
96
|
|
|
|
|
|
|
my $lib_dir = qq{}; ## Local ./lib if found |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
##**************************************************************************** |
99
|
|
|
|
|
|
|
## Object methods |
100
|
|
|
|
|
|
|
##**************************************************************************** |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
=head1 METHODS |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
L inherits its methods from |
105
|
|
|
|
|
|
|
from L |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=cut |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
##**************************************************************************** |
110
|
|
|
|
|
|
|
##**************************************************************************** |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=head2 C |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
$command->run; |
115
|
|
|
|
|
|
|
$command->run(@ARGV); |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
Used to invoke the command. |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
=cut |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
##---------------------------------------------------------------------------- |
122
|
|
|
|
|
|
|
sub run ## no critic (RequireArgUnpacking) |
123
|
|
|
|
|
|
|
{ |
124
|
1
|
|
|
1
|
1
|
499
|
my $self = shift; |
125
|
1
|
|
|
|
|
4
|
my @args = @_; |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
## Parse the options |
128
|
|
|
|
|
|
|
GetOptions( |
129
|
0
|
|
|
0
|
|
0
|
'include-tests' => sub { $include_tests = 1; }, |
130
|
0
|
|
|
0
|
|
0
|
'core' => sub { $skip_core = 0; }, |
131
|
0
|
|
|
0
|
|
0
|
'missing' => sub { $missing_only = 1; }, |
132
|
0
|
|
|
0
|
|
0
|
'skip-lib' => sub { $skip_lib = 1; }, |
133
|
0
|
|
|
0
|
|
0
|
'verbose' => sub { $verbose = 1; }, |
134
|
1
|
|
|
|
|
14
|
); |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
## See if we can load the required modules |
137
|
1
|
|
|
|
|
326
|
foreach my $module (qq{PPI}, qq{Module::Info},) |
138
|
|
|
|
|
|
|
{ |
139
|
2
|
50
|
|
|
|
8
|
unless (_load_module($module)) |
140
|
|
|
|
|
|
|
{ |
141
|
0
|
|
|
|
|
0
|
print STDERR (qq{ERROR: Could not load $module!\n}); |
142
|
0
|
|
|
|
|
0
|
return -1; |
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
## Convert perl version to something find_version can use |
147
|
1
|
|
|
|
|
4
|
my $numeric_v = _numify_version($^V); |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
## Determine hash of core modules |
150
|
1
|
|
|
|
|
11
|
my $core_modules = Module::CoreList->find_version($numeric_v); |
151
|
1
|
50
|
|
|
|
28
|
unless ($core_modules) |
152
|
|
|
|
|
|
|
{ |
153
|
0
|
|
|
|
|
0
|
print STDERR ( |
154
|
|
|
|
|
|
|
qq{ERROR: Could not determine list of core modules }, |
155
|
|
|
|
|
|
|
qq{for this version of perl!\n} |
156
|
|
|
|
|
|
|
); |
157
|
0
|
|
|
|
|
0
|
return -1; |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
## List of files to scan |
161
|
1
|
|
|
|
|
2
|
my @files = (); |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
## Find files to be scanned |
164
|
|
|
|
|
|
|
File::Find::find( |
165
|
|
|
|
|
|
|
{ |
166
|
|
|
|
|
|
|
wanted => sub { |
167
|
|
|
|
|
|
|
## Always look for modules (*.pm) |
168
|
44
|
100
|
|
44
|
|
137
|
push(@files, File::Spec->canonpath($File::Find::name)) |
169
|
|
|
|
|
|
|
if ($_ =~ /\.pm$/x); |
170
|
|
|
|
|
|
|
## Also check test scripts (*.t) if enabled |
171
|
44
|
50
|
33
|
|
|
10354
|
push(@files, File::Spec->canonpath($File::Find::name)) |
172
|
|
|
|
|
|
|
if ($include_tests && ($_ =~ /\.t$/x)); |
173
|
|
|
|
|
|
|
}, |
174
|
|
|
|
|
|
|
}, |
175
|
1
|
|
|
|
|
105
|
qq{.}, ## Starting directory |
176
|
|
|
|
|
|
|
); |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
## Set additional library paths |
179
|
1
|
50
|
|
|
|
27
|
if (-d qq{lib}) |
180
|
|
|
|
|
|
|
{ |
181
|
|
|
|
|
|
|
## Use canonpath to conver file separators |
182
|
1
|
|
|
|
|
40
|
$lib_dir = File::Spec->canonpath(abs_path(qq{./lib})); |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
## Display extra information |
186
|
1
|
50
|
|
|
|
5
|
if ($verbose) |
187
|
|
|
|
|
|
|
{ |
188
|
0
|
0
|
|
|
|
0
|
print( |
189
|
|
|
|
|
|
|
qq{Checking for module dependencies (}, |
190
|
|
|
|
|
|
|
($include_tests ? qq{including} : qq{ignoring}), |
191
|
|
|
|
|
|
|
qq{ test scripts)\n} |
192
|
|
|
|
|
|
|
); |
193
|
0
|
0
|
|
|
|
0
|
print(qq{Adding "./lib/" to include path\n}) if ($lib_dir); |
194
|
0
|
0
|
|
|
|
0
|
print(qq{Skipping modules loaded from "$lib_dir"\n}) if ($lib_dir); |
195
|
0
|
|
|
|
|
0
|
print(qq{Scanning the following:}, |
196
|
|
|
|
|
|
|
qq{\n "}, join(qq{",\n "}, @files), qq{"\n}); |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
## Now scan files for dependencies |
200
|
1
|
|
|
|
|
6
|
my $dependencies = _scan_for_dependencies(@files); |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
## Process the list |
203
|
1
|
|
|
|
|
7
|
_process_results($dependencies, $core_modules); |
204
|
1
|
|
|
|
|
22
|
return (0); |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
##---------------------------------------------------------------------------- |
208
|
|
|
|
|
|
|
## @fn _process_results($modules_ref, $core_modules) |
209
|
|
|
|
|
|
|
## @brief Process the hash reference containing the moudle dependencies |
210
|
|
|
|
|
|
|
## @param $modules_ref - HASH reference whose keys are dependencies |
211
|
|
|
|
|
|
|
## @param $core_modules - HASH reference whose keys are core perl modules |
212
|
|
|
|
|
|
|
## @return |
213
|
|
|
|
|
|
|
## @note |
214
|
|
|
|
|
|
|
##---------------------------------------------------------------------------- |
215
|
|
|
|
|
|
|
sub _process_results |
216
|
|
|
|
|
|
|
{ |
217
|
1
|
|
|
1
|
|
2
|
my $modules_ref = shift; |
218
|
1
|
|
|
|
|
3
|
my $core_modules = shift; |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
## Set the include path for Module::Info |
221
|
1
|
|
|
|
|
11
|
my @new_inc = @INC; |
222
|
1
|
50
|
|
|
|
7
|
push(@new_inc, $lib_dir) if ($lib_dir); |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
## Process the list |
225
|
1
|
|
|
|
|
3
|
foreach my $key (sort(keys(%{$modules_ref}))) |
|
1
|
|
|
|
|
15
|
|
226
|
|
|
|
|
|
|
{ |
227
|
|
|
|
|
|
|
## Convert Module/Name.pm (if needed) |
228
|
8
|
|
|
|
|
349
|
my $module = $key; |
229
|
8
|
|
|
|
|
19
|
$module =~ s{/}{::}gx; |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
## Skip core modules |
232
|
8
|
100
|
66
|
|
|
43
|
next if (exists($core_modules->{$module}) && $skip_core); |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
## Get the module info |
235
|
1
|
|
|
|
|
1558
|
my $module_info = Module::Info->new_from_module($module, @new_inc); |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
## Skip modules that can be found (i.e. have $module_info |
238
|
1
|
50
|
33
|
|
|
559
|
next if ($missing_only && $module_info); |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
## Skip modules that are not located in $lib_dir |
241
|
|
|
|
|
|
|
next |
242
|
1
|
0
|
33
|
|
|
18
|
if ($skip_lib |
|
|
|
33
|
|
|
|
|
|
|
|
0
|
|
|
|
|
243
|
|
|
|
|
|
|
&& $module_info |
244
|
|
|
|
|
|
|
&& $lib_dir |
245
|
|
|
|
|
|
|
&& ($lib_dir eq substr($module_info->file, 0, length($lib_dir)))); |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
## If we get here, then we need to list the file |
248
|
1
|
|
|
|
|
65
|
print($module); |
249
|
1
|
50
|
|
|
|
5
|
if ($verbose) |
250
|
|
|
|
|
|
|
{ |
251
|
0
|
0
|
|
|
|
0
|
if ($module_info) |
252
|
|
|
|
|
|
|
{ |
253
|
|
|
|
|
|
|
## Found the module, so display the filename |
254
|
0
|
|
|
|
|
0
|
print(qq{ loaded from "}, $module_info->file, qq{"}); |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
else |
257
|
|
|
|
|
|
|
{ |
258
|
|
|
|
|
|
|
## Module is missing, so display name of files using the module |
259
|
0
|
|
|
|
|
0
|
print(qq{ MISSING used by "}, |
260
|
0
|
|
|
|
|
0
|
join(qq{", "}, @{$modules_ref->{$module}->{used_by}}), qq{"}); |
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
} |
263
|
1
|
|
|
|
|
18
|
print(qq{\n}); |
264
|
|
|
|
|
|
|
} |
265
|
|
|
|
|
|
|
|
266
|
1
|
|
|
|
|
30
|
return; |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
##---------------------------------------------------------------------------- |
271
|
|
|
|
|
|
|
## @fn _scan_for_dependencies(@file_list) |
272
|
|
|
|
|
|
|
## @brief Use PPI to scan the list of files, returning a hash whose keys |
273
|
|
|
|
|
|
|
## are module names |
274
|
|
|
|
|
|
|
## @param @file_list - List of files to scan |
275
|
|
|
|
|
|
|
## @return HASH REFERENCE - Hash reference whose keys are module names |
276
|
|
|
|
|
|
|
## @note Based on code in Perl::PrereqScanner |
277
|
|
|
|
|
|
|
##---------------------------------------------------------------------------- |
278
|
|
|
|
|
|
|
sub _scan_for_dependencies |
279
|
|
|
|
|
|
|
{ |
280
|
1
|
|
|
1
|
|
4
|
my @files = @_; |
281
|
1
|
|
|
|
|
3
|
my $result = {}; |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
## Iterate through the list of files |
284
|
1
|
|
|
|
|
3
|
foreach my $file (@files) |
285
|
|
|
|
|
|
|
{ |
286
|
|
|
|
|
|
|
## Use PPI to parse the perl source |
287
|
2
|
|
|
|
|
12329
|
my $ppi_doc = PPI::Document->new($file); |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
## See if PPI encountered problems |
290
|
2
|
50
|
|
|
|
425039
|
if (defined($ppi_doc)) |
291
|
|
|
|
|
|
|
{ |
292
|
|
|
|
|
|
|
## Find regular use and require |
293
|
2
|
|
50
|
|
|
17
|
my $includes = $ppi_doc->find('Statement::Include') || []; |
294
|
2
|
|
|
|
|
119897
|
for my $node (@{$includes}) |
|
2
|
|
|
|
|
34
|
|
295
|
|
|
|
|
|
|
{ |
296
|
|
|
|
|
|
|
## Ignore perl version require/use statments (i.e. "use 5.8;" |
297
|
16
|
50
|
|
|
|
47
|
next if ($node->version); |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
## lib.pm is not a "real" dependency, so ignore it |
300
|
16
|
50
|
|
|
|
345
|
next if grep { $_ eq $node->module } qw{ lib }; |
|
16
|
|
|
|
|
37
|
|
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
## Check for inheritance ("base 'Foo::Bar';" |
303
|
16
|
50
|
|
|
|
317
|
if (grep { $_ eq $node->module } qw{ base parent }) |
|
32
|
|
|
|
|
317
|
|
304
|
|
|
|
|
|
|
{ |
305
|
|
|
|
|
|
|
## Ignore the arguments, just look for the name of the parent |
306
|
0
|
0
|
|
|
|
0
|
my @important = grep { |
307
|
0
|
|
|
|
|
0
|
$_->isa('PPI::Token::QuoteLike::Words') |
308
|
|
|
|
|
|
|
|| $_->isa('PPI::Token::Quote') |
309
|
|
|
|
|
|
|
} $node->arguments; |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
## Based on code from Perl::PrereqScanner |
312
|
0
|
0
|
0
|
|
|
0
|
my @base_modules = map { |
313
|
0
|
|
|
|
|
0
|
( |
314
|
|
|
|
|
|
|
( |
315
|
|
|
|
|
|
|
$_->isa('PPI::Token::QuoteLike::Words') |
316
|
|
|
|
|
|
|
|| $_->isa('PPI::Token::Number') |
317
|
|
|
|
|
|
|
) ? $_->literal : $_->string |
318
|
|
|
|
|
|
|
) |
319
|
|
|
|
|
|
|
} @important; |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
## Add the modules |
322
|
0
|
|
|
|
|
0
|
foreach my $module (@base_modules) |
323
|
|
|
|
|
|
|
{ |
324
|
|
|
|
|
|
|
## Add the dependency of the parent |
325
|
0
|
|
|
|
|
0
|
_add_used_by($result, $module, $file); |
326
|
|
|
|
|
|
|
} |
327
|
|
|
|
|
|
|
} |
328
|
|
|
|
|
|
|
else |
329
|
|
|
|
|
|
|
{ |
330
|
|
|
|
|
|
|
## Skip statements like "require $foo" |
331
|
16
|
50
|
|
|
|
302
|
next unless $node->module; |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
## Add the dependency |
334
|
16
|
|
|
|
|
326
|
_add_used_by($result, $node->module, $file); |
335
|
|
|
|
|
|
|
} |
336
|
|
|
|
|
|
|
} |
337
|
|
|
|
|
|
|
} |
338
|
|
|
|
|
|
|
else |
339
|
|
|
|
|
|
|
{ |
340
|
0
|
|
|
|
|
0
|
print STDERR (qq{Could not scan file "$file"\n}); |
341
|
|
|
|
|
|
|
} |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
|
344
|
1
|
|
|
|
|
17344
|
return ($result); |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
##---------------------------------------------------------------------------- |
348
|
|
|
|
|
|
|
## @fn _add_used_by($hash_ref, $module_name, $used_by) |
349
|
|
|
|
|
|
|
## @brief Add an entry to the given hash (or create the entry if needed) |
350
|
|
|
|
|
|
|
## @param $hash_ref - HASH reference whose keys are module names |
351
|
|
|
|
|
|
|
## @param $module_name - Name of the required module |
352
|
|
|
|
|
|
|
## @param $used_by - Name of the script requiring the module |
353
|
|
|
|
|
|
|
## @return |
354
|
|
|
|
|
|
|
## @note |
355
|
|
|
|
|
|
|
##---------------------------------------------------------------------------- |
356
|
|
|
|
|
|
|
sub _add_used_by |
357
|
|
|
|
|
|
|
{ |
358
|
16
|
|
|
16
|
|
274
|
my $hash_ref = shift; |
359
|
16
|
|
|
|
|
18
|
my $module_name = shift; |
360
|
16
|
|
|
|
|
19
|
my $used_by = shift; |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
## See if entry exists |
363
|
16
|
100
|
|
|
|
38
|
unless (exists($hash_ref->{$module_name})) |
364
|
|
|
|
|
|
|
{ |
365
|
|
|
|
|
|
|
## Entry does not exist, so create a new entry |
366
|
8
|
|
|
|
|
27
|
$hash_ref->{$module_name} = {used_by => [],}; |
367
|
|
|
|
|
|
|
} |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
## Add to the used_by key |
370
|
16
|
|
|
|
|
18
|
push(@{$hash_ref->{$module_name}->{used_by}}, $used_by); |
|
16
|
|
|
|
|
35
|
|
371
|
|
|
|
|
|
|
|
372
|
16
|
|
|
|
|
53
|
return; |
373
|
|
|
|
|
|
|
} |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
##---------------------------------------------------------------------------- |
376
|
|
|
|
|
|
|
## @fn _load_module($module) |
377
|
|
|
|
|
|
|
## @brief Load the given module and return TRUE if module was loaded |
378
|
|
|
|
|
|
|
## @param $module - Name of the module |
379
|
|
|
|
|
|
|
## @return |
380
|
|
|
|
|
|
|
## @note |
381
|
|
|
|
|
|
|
##---------------------------------------------------------------------------- |
382
|
|
|
|
|
|
|
sub _load_module |
383
|
|
|
|
|
|
|
{ |
384
|
3
|
|
|
3
|
|
7
|
my $module = shift; |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
## For ease of reading |
387
|
3
|
|
|
|
|
11
|
my $eval_stmt = qq{require $module; import $module; 1;}; |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
## Attempt to load module |
390
|
3
|
|
|
|
|
286
|
my $loaded = eval $eval_stmt; ## no critic (ProhibitStringyEval) |
391
|
|
|
|
|
|
|
|
392
|
3
|
|
|
|
|
38
|
return $loaded; |
393
|
|
|
|
|
|
|
} |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
##---------------------------------------------------------------------------- |
396
|
|
|
|
|
|
|
## @fn numify_version($ver) |
397
|
|
|
|
|
|
|
## @brief Examine proivded version and return as version number |
398
|
|
|
|
|
|
|
## @param $ver - Version |
399
|
|
|
|
|
|
|
## @return SCALAR - Numeric representation of version |
400
|
|
|
|
|
|
|
## @note |
401
|
|
|
|
|
|
|
##---------------------------------------------------------------------------- |
402
|
|
|
|
|
|
|
sub _numify_version |
403
|
|
|
|
|
|
|
{ |
404
|
1
|
|
|
1
|
|
3
|
my $ver = shift; |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
## See if version has multiple dots |
407
|
1
|
50
|
|
|
|
11
|
if ($ver =~ /\..+\./x) |
408
|
|
|
|
|
|
|
{ |
409
|
|
|
|
|
|
|
## We need the version module to convert |
410
|
1
|
50
|
|
|
|
5
|
unless (_load_module(qq{version})) |
411
|
|
|
|
|
|
|
{ |
412
|
0
|
|
|
|
|
0
|
print STDERR (qq{ERROR: Cannot determine version from "$ver"\n}); |
413
|
0
|
|
|
|
|
0
|
return -1; |
414
|
|
|
|
|
|
|
} |
415
|
|
|
|
|
|
|
## Convert version into number |
416
|
1
|
|
|
|
|
15
|
$ver = version->new($ver)->numify; |
417
|
|
|
|
|
|
|
} |
418
|
|
|
|
|
|
|
## Added 0 ensures perl treats variable as numeric |
419
|
1
|
|
|
|
|
6
|
$ver += 0; |
420
|
|
|
|
|
|
|
|
421
|
1
|
|
|
|
|
4
|
return $ver; |
422
|
|
|
|
|
|
|
} |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
1; |
425
|
|
|
|
|
|
|
__END__ |