Filename | /usr/share/perl/5.36/Module/Load/Conditional.pm |
Statements | Executed 41 statements in 1.51ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 2.89ms | 6.18ms | BEGIN@14 | Module::Load::Conditional::
1 | 1 | 1 | 691µs | 845µs | BEGIN@12 | Module::Load::Conditional::
1 | 1 | 1 | 643µs | 704µs | BEGIN@5 | Module::Load::Conditional::
1 | 1 | 1 | 9µs | 9µs | BEGIN@20 | Module::Load::Conditional::
1 | 1 | 1 | 8µs | 9µs | BEGIN@3 | Module::Load::Conditional::
1 | 1 | 1 | 6µs | 39µs | BEGIN@16 | Module::Load::Conditional::
1 | 1 | 1 | 6µs | 11µs | BEGIN@196 | Module::Load::Conditional::
1 | 1 | 1 | 5µs | 17µs | BEGIN@323 | Module::Load::Conditional::
1 | 1 | 1 | 4µs | 16µs | BEGIN@6 | Module::Load::Conditional::
1 | 1 | 1 | 4µs | 12µs | BEGIN@23 | Module::Load::Conditional::
1 | 1 | 1 | 4µs | 20µs | BEGIN@17 | Module::Load::Conditional::
1 | 1 | 1 | 4µs | 51µs | BEGIN@21 | Module::Load::Conditional::
1 | 1 | 1 | 4µs | 18µs | BEGIN@18 | Module::Load::Conditional::
1 | 1 | 1 | 3µs | 92µs | BEGIN@7 | Module::Load::Conditional::
1 | 1 | 1 | 2µs | 2µs | BEGIN@10 | Module::Load::Conditional::
1 | 1 | 1 | 2µs | 2µs | BEGIN@9 | Module::Load::Conditional::
1 | 1 | 1 | 1µs | 1µs | BEGIN@11 | Module::Load::Conditional::
0 | 0 | 0 | 0s | 0s | __ANON__[:264] | Module::Load::Conditional::
0 | 0 | 0 | 0s | 0s | can_load | Module::Load::Conditional::
0 | 0 | 0 | 0s | 0s | check_install | Module::Load::Conditional::
0 | 0 | 0 | 0s | 0s | requires | Module::Load::Conditional::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Module::Load::Conditional; | ||||
2 | |||||
3 | 2 | 20µs | 2 | 11µs | # spent 9µs (8+1) within Module::Load::Conditional::BEGIN@3 which was called:
# once (8µs+1µs) by IPC::Cmd::BEGIN@61 at line 3 # spent 9µs making 1 call to Module::Load::Conditional::BEGIN@3
# spent 1µs making 1 call to strict::import |
4 | |||||
5 | 2 | 93µs | 2 | 723µs | # spent 704µs (643+61) within Module::Load::Conditional::BEGIN@5 which was called:
# once (643µs+61µs) by IPC::Cmd::BEGIN@61 at line 5 # spent 704µs making 1 call to Module::Load::Conditional::BEGIN@5
# spent 18µs making 1 call to Module::Load::import |
6 | 2 | 16µs | 2 | 27µs | # spent 16µs (4+11) within Module::Load::Conditional::BEGIN@6 which was called:
# once (4µs+11µs) by IPC::Cmd::BEGIN@61 at line 6 # spent 16µs making 1 call to Module::Load::Conditional::BEGIN@6
# spent 12µs making 1 call to Exporter::import |
7 | 2 | 15µs | 2 | 181µs | # spent 92µs (3+89) within Module::Load::Conditional::BEGIN@7 which was called:
# once (3µs+89µs) by IPC::Cmd::BEGIN@61 at line 7 # spent 92µs making 1 call to Module::Load::Conditional::BEGIN@7
# spent 89µs making 1 call to Locale::Maketext::Simple::import |
8 | |||||
9 | 2 | 10µs | 1 | 2µs | # spent 2µs within Module::Load::Conditional::BEGIN@9 which was called:
# once (2µs+0s) by IPC::Cmd::BEGIN@61 at line 9 # spent 2µs making 1 call to Module::Load::Conditional::BEGIN@9 |
10 | 2 | 8µs | 1 | 2µs | # spent 2µs within Module::Load::Conditional::BEGIN@10 which was called:
# once (2µs+0s) by IPC::Cmd::BEGIN@61 at line 10 # spent 2µs making 1 call to Module::Load::Conditional::BEGIN@10 |
11 | 2 | 10µs | 1 | 1µs | # spent 1µs within Module::Load::Conditional::BEGIN@11 which was called:
# once (1µs+0s) by IPC::Cmd::BEGIN@61 at line 11 # spent 1µs making 1 call to Module::Load::Conditional::BEGIN@11 |
12 | 2 | 93µs | 2 | 862µs | # spent 845µs (691+154) within Module::Load::Conditional::BEGIN@12 which was called:
# once (691µs+154µs) by IPC::Cmd::BEGIN@61 at line 12 # spent 845µs making 1 call to Module::Load::Conditional::BEGIN@12
# spent 17µs making 1 call to version::import |
13 | |||||
14 | 2 | 125µs | 1 | 6.18ms | # spent 6.18ms (2.89+3.29) within Module::Load::Conditional::BEGIN@14 which was called:
# once (2.89ms+3.29ms) by IPC::Cmd::BEGIN@61 at line 14 # spent 6.18ms making 1 call to Module::Load::Conditional::BEGIN@14 |
15 | |||||
16 | 2 | 25µs | 2 | 72µs | # spent 39µs (6+32) within Module::Load::Conditional::BEGIN@16 which was called:
# once (6µs+32µs) by IPC::Cmd::BEGIN@61 at line 16 # spent 39µs making 1 call to Module::Load::Conditional::BEGIN@16
# spent 32µs making 1 call to constant::import |
17 | 2 | 22µs | 2 | 36µs | # spent 20µs (4+16) within Module::Load::Conditional::BEGIN@17 which was called:
# once (4µs+16µs) by IPC::Cmd::BEGIN@61 at line 17 # spent 20µs making 1 call to Module::Load::Conditional::BEGIN@17
# spent 16µs making 1 call to constant::import |
18 | 2 | 23µs | 2 | 32µs | # spent 18µs (4+14) within Module::Load::Conditional::BEGIN@18 which was called:
# once (4µs+14µs) by IPC::Cmd::BEGIN@61 at line 18 # spent 18µs making 1 call to Module::Load::Conditional::BEGIN@18
# spent 14µs making 1 call to constant::import |
19 | |||||
20 | # spent 9µs within Module::Load::Conditional::BEGIN@20 which was called:
# once (9µs+0s) by IPC::Cmd::BEGIN@61 at line 32 | ||||
21 | 1 | 3µs | 1 | 47µs | # spent 51µs (4+47) within Module::Load::Conditional::BEGIN@21 which was called:
# once (4µs+47µs) by IPC::Cmd::BEGIN@61 at line 22 # spent 47µs making 1 call to vars::import |
22 | 1 | 13µs | 1 | 51µs | $FIND_VERSION $ERROR $CHECK_INC_HASH $FORCE_SAFE_INC ]; # spent 51µs making 1 call to Module::Load::Conditional::BEGIN@21 |
23 | 2 | 72µs | 2 | 21µs | # spent 12µs (4+8) within Module::Load::Conditional::BEGIN@23 which was called:
# once (4µs+8µs) by IPC::Cmd::BEGIN@61 at line 23 # spent 12µs making 1 call to Module::Load::Conditional::BEGIN@23
# spent 8µs making 1 call to Exporter::import |
24 | 1 | 6µs | @ISA = qw[Exporter]; | ||
25 | 1 | 200ns | $VERSION = '0.74'; | ||
26 | 1 | 100ns | $VERBOSE = 0; | ||
27 | 1 | 100ns | $DEPRECATED = 0; | ||
28 | 1 | 100ns | $FIND_VERSION = 1; | ||
29 | 1 | 0s | $CHECK_INC_HASH = 0; | ||
30 | 1 | 100ns | $FORCE_SAFE_INC = 0; | ||
31 | 1 | 2µs | @EXPORT_OK = qw[check_install can_load requires]; | ||
32 | 1 | 133µs | 1 | 9µs | } # spent 9µs making 1 call to Module::Load::Conditional::BEGIN@20 |
33 | |||||
34 | =pod | ||||
35 | |||||
36 | =head1 NAME | ||||
37 | |||||
38 | Module::Load::Conditional - Looking up module information / loading at runtime | ||||
39 | |||||
40 | =head1 SYNOPSIS | ||||
41 | |||||
42 | use Module::Load::Conditional qw[can_load check_install requires]; | ||||
43 | |||||
44 | |||||
45 | my $use_list = { | ||||
46 | CPANPLUS => 0.05, | ||||
47 | LWP => 5.60, | ||||
48 | 'Test::More' => undef, | ||||
49 | }; | ||||
50 | |||||
51 | print can_load( modules => $use_list ) | ||||
52 | ? 'all modules loaded successfully' | ||||
53 | : 'failed to load required modules'; | ||||
54 | |||||
55 | |||||
56 | my $rv = check_install( module => 'LWP', version => 5.60 ) | ||||
57 | or print 'LWP is not installed!'; | ||||
58 | |||||
59 | print 'LWP up to date' if $rv->{uptodate}; | ||||
60 | print "LWP version is $rv->{version}\n"; | ||||
61 | print "LWP is installed as file $rv->{file}\n"; | ||||
62 | |||||
63 | |||||
64 | print "LWP requires the following modules to be installed:\n"; | ||||
65 | print join "\n", requires('LWP'); | ||||
66 | |||||
67 | ### allow M::L::C to peek in your %INC rather than just | ||||
68 | ### scanning @INC | ||||
69 | $Module::Load::Conditional::CHECK_INC_HASH = 1; | ||||
70 | |||||
71 | ### reset the 'can_load' cache | ||||
72 | undef $Module::Load::Conditional::CACHE; | ||||
73 | |||||
74 | ### don't have Module::Load::Conditional issue warnings -- | ||||
75 | ### default is '1' | ||||
76 | $Module::Load::Conditional::VERBOSE = 0; | ||||
77 | |||||
78 | ### The last error that happened during a call to 'can_load' | ||||
79 | my $err = $Module::Load::Conditional::ERROR; | ||||
80 | |||||
81 | |||||
82 | =head1 DESCRIPTION | ||||
83 | |||||
84 | Module::Load::Conditional provides simple ways to query and possibly load any of | ||||
85 | the modules you have installed on your system during runtime. | ||||
86 | |||||
87 | It is able to load multiple modules at once or none at all if one of | ||||
88 | them was not able to load. It also takes care of any error checking | ||||
89 | and so forth. | ||||
90 | |||||
91 | =head1 Methods | ||||
92 | |||||
93 | =head2 $href = check_install( module => NAME [, version => VERSION, verbose => BOOL ] ); | ||||
94 | |||||
95 | C<check_install> allows you to verify if a certain module is installed | ||||
96 | or not. You may call it with the following arguments: | ||||
97 | |||||
98 | =over 4 | ||||
99 | |||||
100 | =item module | ||||
101 | |||||
102 | The name of the module you wish to verify -- this is a required key | ||||
103 | |||||
104 | =item version | ||||
105 | |||||
106 | The version this module needs to be -- this is optional | ||||
107 | |||||
108 | =item verbose | ||||
109 | |||||
110 | Whether or not to be verbose about what it is doing -- it will default | ||||
111 | to $Module::Load::Conditional::VERBOSE | ||||
112 | |||||
113 | =back | ||||
114 | |||||
115 | It will return undef if it was not able to find where the module was | ||||
116 | installed, or a hash reference with the following keys if it was able | ||||
117 | to find the file: | ||||
118 | |||||
119 | =over 4 | ||||
120 | |||||
121 | =item file | ||||
122 | |||||
123 | Full path to the file that contains the module | ||||
124 | |||||
125 | =item dir | ||||
126 | |||||
127 | Directory, or more exact the C<@INC> entry, where the module was | ||||
128 | loaded from. | ||||
129 | |||||
130 | =item version | ||||
131 | |||||
132 | The version number of the installed module - this will be C<undef> if | ||||
133 | the module had no (or unparsable) version number, or if the variable | ||||
134 | C<$Module::Load::Conditional::FIND_VERSION> was set to true. | ||||
135 | (See the C<GLOBAL VARIABLES> section below for details) | ||||
136 | |||||
137 | =item uptodate | ||||
138 | |||||
139 | A boolean value indicating whether or not the module was found to be | ||||
140 | at least the version you specified. If you did not specify a version, | ||||
141 | uptodate will always be true if the module was found. | ||||
142 | If no parsable version was found in the module, uptodate will also be | ||||
143 | true, since C<check_install> had no way to verify clearly. | ||||
144 | |||||
145 | See also C<$Module::Load::Conditional::DEPRECATED>, which affects | ||||
146 | the outcome of this value. | ||||
147 | |||||
148 | =back | ||||
149 | |||||
150 | =cut | ||||
151 | |||||
152 | ### this checks if a certain module is installed already ### | ||||
153 | ### if it returns true, the module in question is already installed | ||||
154 | ### or we found the file, but couldn't open it, OR there was no version | ||||
155 | ### to be found in the module | ||||
156 | ### it will return 0 if the version in the module is LOWER then the one | ||||
157 | ### we are looking for, or if we couldn't find the desired module to begin with | ||||
158 | ### if the installed version is higher or equal to the one we want, it will return | ||||
159 | ### a hashref with he module name and version in it.. so 'true' as well. | ||||
160 | sub check_install { | ||||
161 | my %hash = @_; | ||||
162 | |||||
163 | my $tmpl = { | ||||
164 | version => { default => '0.0' }, | ||||
165 | module => { required => 1 }, | ||||
166 | verbose => { default => $VERBOSE }, | ||||
167 | }; | ||||
168 | |||||
169 | my $args; | ||||
170 | unless( $args = check( $tmpl, \%hash, $VERBOSE ) ) { | ||||
171 | warn loc( q[A problem occurred checking arguments] ) if $VERBOSE; | ||||
172 | return; | ||||
173 | } | ||||
174 | |||||
175 | my $file = File::Spec->catfile( split /::/, $args->{module} ) . '.pm'; | ||||
176 | my $file_inc = File::Spec::Unix->catfile( | ||||
177 | split /::/, $args->{module} | ||||
178 | ) . '.pm'; | ||||
179 | |||||
180 | ### where we store the return value ### | ||||
181 | my $href = { | ||||
182 | file => undef, | ||||
183 | version => undef, | ||||
184 | uptodate => undef, | ||||
185 | }; | ||||
186 | |||||
187 | my $filename; | ||||
188 | |||||
189 | ### check the inc hash if we're allowed to | ||||
190 | if( $CHECK_INC_HASH ) { | ||||
191 | $filename = $href->{'file'} = | ||||
192 | $INC{ $file_inc } if defined $INC{ $file_inc }; | ||||
193 | |||||
194 | ### find the version by inspecting the package | ||||
195 | if( defined $filename && $FIND_VERSION ) { | ||||
196 | 2 | 281µs | 2 | 17µs | # spent 11µs (6+5) within Module::Load::Conditional::BEGIN@196 which was called:
# once (6µs+5µs) by IPC::Cmd::BEGIN@61 at line 196 # spent 11µs making 1 call to Module::Load::Conditional::BEGIN@196
# spent 5µs making 1 call to strict::unimport |
197 | $href->{version} = ${ "$args->{module}"."::VERSION" }; | ||||
198 | } | ||||
199 | } | ||||
200 | |||||
201 | ### we didn't find the filename yet by looking in %INC, | ||||
202 | ### so scan the dirs | ||||
203 | unless( $filename ) { | ||||
204 | |||||
205 | local @INC = @INC[0..$#INC-1] if $FORCE_SAFE_INC && $INC[-1] eq '.'; | ||||
206 | |||||
207 | DIR: for my $dir ( @INC ) { | ||||
208 | |||||
209 | my $fh; | ||||
210 | |||||
211 | if ( ref $dir ) { | ||||
212 | ### @INC hook -- we invoke it and get the filehandle back | ||||
213 | ### this is actually documented behaviour as of 5.8 ;) | ||||
214 | |||||
215 | my $existed_in_inc = $INC{$file_inc}; | ||||
216 | |||||
217 | if (UNIVERSAL::isa($dir, 'CODE')) { | ||||
218 | ($fh) = $dir->($dir, $file); | ||||
219 | |||||
220 | } elsif (UNIVERSAL::isa($dir, 'ARRAY')) { | ||||
221 | ($fh) = $dir->[0]->($dir, $file, @{$dir}{1..$#{$dir}}) | ||||
222 | |||||
223 | } elsif (UNIVERSAL::can($dir, 'INC')) { | ||||
224 | ($fh) = $dir->INC($file); | ||||
225 | } | ||||
226 | |||||
227 | if (!UNIVERSAL::isa($fh, 'GLOB')) { | ||||
228 | warn loc(q[Cannot open file '%1': %2], $file, $!) | ||||
229 | if $args->{verbose}; | ||||
230 | next; | ||||
231 | } | ||||
232 | |||||
233 | $filename = $INC{$file_inc} || $file; | ||||
234 | |||||
235 | delete $INC{$file_inc} if not $existed_in_inc; | ||||
236 | |||||
237 | } else { | ||||
238 | $filename = File::Spec->catfile($dir, $file); | ||||
239 | next unless -e $filename; | ||||
240 | |||||
241 | $fh = FileHandle->new(); | ||||
242 | if (!$fh->open($filename)) { | ||||
243 | warn loc(q[Cannot open file '%1': %2], $file, $!) | ||||
244 | if $args->{verbose}; | ||||
245 | next; | ||||
246 | } | ||||
247 | } | ||||
248 | |||||
249 | ### store the directory we found the file in | ||||
250 | $href->{dir} = $dir; | ||||
251 | |||||
252 | ### files need to be in unix format under vms, | ||||
253 | ### or they might be loaded twice | ||||
254 | $href->{file} = ON_VMS | ||||
255 | ? VMS::Filespec::unixify( $filename ) | ||||
256 | : $filename; | ||||
257 | |||||
258 | ### if we don't need the version, we're done | ||||
259 | last DIR unless $FIND_VERSION; | ||||
260 | |||||
261 | ### otherwise, the user wants us to find the version from files | ||||
262 | |||||
263 | { | ||||
264 | local $SIG{__WARN__} = sub {}; | ||||
265 | my $ver = eval { | ||||
266 | my $mod_info = Module::Metadata->new_from_handle( $fh, $filename ); | ||||
267 | $mod_info->version( $args->{module} ); | ||||
268 | }; | ||||
269 | |||||
270 | if( defined $ver ) { | ||||
271 | $href->{version} = $ver; | ||||
272 | |||||
273 | last DIR; | ||||
274 | } | ||||
275 | } | ||||
276 | } | ||||
277 | } | ||||
278 | |||||
279 | ### if we couldn't find the file, return undef ### | ||||
280 | return unless defined $href->{file}; | ||||
281 | |||||
282 | ### only complain if we're expected to find a version higher than 0.0 anyway | ||||
283 | if( $FIND_VERSION and not defined $href->{version} ) { | ||||
284 | { ### don't warn about the 'not numeric' stuff ### | ||||
285 | local $^W; | ||||
286 | |||||
287 | ### if we got here, we didn't find the version | ||||
288 | warn loc(q[Could not check version on '%1'], $args->{module} ) | ||||
289 | if $args->{verbose} and $args->{version} > 0; | ||||
290 | } | ||||
291 | $href->{uptodate} = 1; | ||||
292 | |||||
293 | } else { | ||||
294 | ### don't warn about the 'not numeric' stuff ### | ||||
295 | local $^W; | ||||
296 | |||||
297 | ### use qv(), as it will deal with developer release number | ||||
298 | ### ie ones containing _ as well. This addresses bug report | ||||
299 | ### #29348: Version compare logic doesn't handle alphas? | ||||
300 | ### | ||||
301 | ### Update from JPeacock: apparently qv() and version->new | ||||
302 | ### are different things, and we *must* use version->new | ||||
303 | ### here, or things like #30056 might start happening | ||||
304 | |||||
305 | ### We have to wrap this in an eval as version-0.82 raises | ||||
306 | ### exceptions and not warnings now *sigh* | ||||
307 | |||||
308 | eval { | ||||
309 | |||||
310 | $href->{uptodate} = | ||||
311 | version->new( $args->{version} ) <= version->new( $href->{version} ) | ||||
312 | ? 1 | ||||
313 | : 0; | ||||
314 | |||||
315 | }; | ||||
316 | } | ||||
317 | |||||
318 | if ( $DEPRECATED and "$]" >= 5.011 ) { | ||||
319 | local @INC = @INC[0..$#INC-1] if $FORCE_SAFE_INC && $INC[-1] eq '.'; | ||||
320 | require Module::CoreList; | ||||
321 | require Config; | ||||
322 | |||||
323 | 2 | 540µs | 2 | 30µs | # spent 17µs (5+12) within Module::Load::Conditional::BEGIN@323 which was called:
# once (5µs+12µs) by IPC::Cmd::BEGIN@61 at line 323 # spent 17µs making 1 call to Module::Load::Conditional::BEGIN@323
# spent 12µs making 1 call to warnings::unimport |
324 | $href->{uptodate} = 0 if | ||||
325 | exists $Module::CoreList::version{ 0+$] }{ $args->{module} } and | ||||
326 | Module::CoreList::is_deprecated( $args->{module} ) and | ||||
327 | $Config::Config{privlibexp} eq $href->{dir} | ||||
328 | and $Config::Config{privlibexp} ne $Config::Config{sitelibexp}; | ||||
329 | } | ||||
330 | |||||
331 | return $href; | ||||
332 | } | ||||
333 | |||||
334 | =head2 $bool = can_load( modules => { NAME => VERSION [,NAME => VERSION] }, [verbose => BOOL, nocache => BOOL, autoload => BOOL] ) | ||||
335 | |||||
336 | C<can_load> will take a list of modules, optionally with version | ||||
337 | numbers and determine if it is able to load them. If it can load *ALL* | ||||
338 | of them, it will. If one or more are unloadable, none will be loaded. | ||||
339 | |||||
340 | This is particularly useful if you have More Than One Way (tm) to | ||||
341 | solve a problem in a program, and only wish to continue down a path | ||||
342 | if all modules could be loaded, and not load them if they couldn't. | ||||
343 | |||||
344 | This function uses the C<load> function or the C<autoload_remote> function | ||||
345 | from Module::Load under the hood. | ||||
346 | |||||
347 | C<can_load> takes the following arguments: | ||||
348 | |||||
349 | =over 4 | ||||
350 | |||||
351 | =item modules | ||||
352 | |||||
353 | This is a hashref of module/version pairs. The version indicates the | ||||
354 | minimum version to load. If no version is provided, any version is | ||||
355 | assumed to be good enough. | ||||
356 | |||||
357 | =item verbose | ||||
358 | |||||
359 | This controls whether warnings should be printed if a module failed | ||||
360 | to load. | ||||
361 | The default is to use the value of $Module::Load::Conditional::VERBOSE. | ||||
362 | |||||
363 | =item nocache | ||||
364 | |||||
365 | C<can_load> keeps its results in a cache, so it will not load the | ||||
366 | same module twice, nor will it attempt to load a module that has | ||||
367 | already failed to load before. By default, C<can_load> will check its | ||||
368 | cache, but you can override that by setting C<nocache> to true. | ||||
369 | |||||
370 | =item autoload | ||||
371 | |||||
372 | This controls whether imports the functions of a loaded modules to the caller package. The default is no importing any functions. | ||||
373 | |||||
374 | See the C<autoload> function and the C<autoload_remote> function from L<Module::Load> for details. | ||||
375 | |||||
376 | =cut | ||||
377 | |||||
378 | sub can_load { | ||||
379 | my %hash = @_; | ||||
380 | |||||
381 | my $tmpl = { | ||||
382 | modules => { default => {}, strict_type => 1 }, | ||||
383 | verbose => { default => $VERBOSE }, | ||||
384 | nocache => { default => 0 }, | ||||
385 | autoload => { default => 0 }, | ||||
386 | }; | ||||
387 | |||||
388 | my $args; | ||||
389 | |||||
390 | unless( $args = check( $tmpl, \%hash, $VERBOSE ) ) { | ||||
391 | $ERROR = loc(q[Problem validating arguments!]); | ||||
392 | warn $ERROR if $VERBOSE; | ||||
393 | return; | ||||
394 | } | ||||
395 | |||||
396 | ### layout of $CACHE: | ||||
397 | ### $CACHE = { | ||||
398 | ### $ module => { | ||||
399 | ### usable => BOOL, | ||||
400 | ### version => \d, | ||||
401 | ### file => /path/to/file, | ||||
402 | ### }, | ||||
403 | ### }; | ||||
404 | |||||
405 | $CACHE ||= {}; # in case it was undef'd | ||||
406 | |||||
407 | my $error; | ||||
408 | BLOCK: { | ||||
409 | my $href = $args->{modules}; | ||||
410 | |||||
411 | my @load; | ||||
412 | for my $mod ( keys %$href ) { | ||||
413 | |||||
414 | next if $CACHE->{$mod}->{usable} && !$args->{nocache}; | ||||
415 | |||||
416 | ### else, check if the hash key is defined already, | ||||
417 | ### meaning $mod => 0, | ||||
418 | ### indicating UNSUCCESSFUL prior attempt of usage | ||||
419 | |||||
420 | ### use qv(), as it will deal with developer release number | ||||
421 | ### ie ones containing _ as well. This addresses bug report | ||||
422 | ### #29348: Version compare logic doesn't handle alphas? | ||||
423 | ### | ||||
424 | ### Update from JPeacock: apparently qv() and version->new | ||||
425 | ### are different things, and we *must* use version->new | ||||
426 | ### here, or things like #30056 might start happening | ||||
427 | if ( !$args->{nocache} | ||||
428 | && defined $CACHE->{$mod}->{usable} | ||||
429 | && (version->new( $CACHE->{$mod}->{version}||0 ) | ||||
430 | >= version->new( $href->{$mod} ) ) | ||||
431 | ) { | ||||
432 | $error = loc( q[Already tried to use '%1', which was unsuccessful], $mod); | ||||
433 | last BLOCK; | ||||
434 | } | ||||
435 | |||||
436 | my $mod_data = check_install( | ||||
437 | module => $mod, | ||||
438 | version => $href->{$mod} | ||||
439 | ); | ||||
440 | |||||
441 | if( !$mod_data or !defined $mod_data->{file} ) { | ||||
442 | $error = loc(q[Could not find or check module '%1'], $mod); | ||||
443 | $CACHE->{$mod}->{usable} = 0; | ||||
444 | last BLOCK; | ||||
445 | } | ||||
446 | |||||
447 | map { | ||||
448 | $CACHE->{$mod}->{$_} = $mod_data->{$_} | ||||
449 | } qw[version file uptodate]; | ||||
450 | |||||
451 | push @load, $mod; | ||||
452 | } | ||||
453 | |||||
454 | for my $mod ( @load ) { | ||||
455 | |||||
456 | if ( $CACHE->{$mod}->{uptodate} ) { | ||||
457 | |||||
458 | local @INC = @INC[0..$#INC-1] if $FORCE_SAFE_INC && $INC[-1] eq '.'; | ||||
459 | |||||
460 | if ( $args->{autoload} ) { | ||||
461 | my $who = (caller())[0]; | ||||
462 | eval { autoload_remote $who, $mod }; | ||||
463 | } else { | ||||
464 | eval { load $mod }; | ||||
465 | } | ||||
466 | |||||
467 | ### in case anything goes wrong, log the error, the fact | ||||
468 | ### we tried to use this module and return 0; | ||||
469 | if( $@ ) { | ||||
470 | $error = $@; | ||||
471 | $CACHE->{$mod}->{usable} = 0; | ||||
472 | last BLOCK; | ||||
473 | } else { | ||||
474 | $CACHE->{$mod}->{usable} = 1; | ||||
475 | } | ||||
476 | |||||
477 | ### module not found in @INC, store the result in | ||||
478 | ### $CACHE and return 0 | ||||
479 | } else { | ||||
480 | |||||
481 | $error = loc(q[Module '%1' is not uptodate!], $mod); | ||||
482 | $CACHE->{$mod}->{usable} = 0; | ||||
483 | last BLOCK; | ||||
484 | } | ||||
485 | } | ||||
486 | |||||
487 | } # BLOCK | ||||
488 | |||||
489 | if( defined $error ) { | ||||
490 | $ERROR = $error; | ||||
491 | Carp::carp( loc(q|%1 [THIS MAY BE A PROBLEM!]|,$error) ) if $args->{verbose}; | ||||
492 | return; | ||||
493 | } else { | ||||
494 | return 1; | ||||
495 | } | ||||
496 | } | ||||
497 | |||||
498 | =back | ||||
499 | |||||
500 | =head2 @list = requires( MODULE ); | ||||
501 | |||||
502 | C<requires> can tell you what other modules a particular module | ||||
503 | requires. This is particularly useful when you're intending to write | ||||
504 | a module for public release and are listing its prerequisites. | ||||
505 | |||||
506 | C<requires> takes but one argument: the name of a module. | ||||
507 | It will then first check if it can actually load this module, and | ||||
508 | return undef if it can't. | ||||
509 | Otherwise, it will return a list of modules and pragmas that would | ||||
510 | have been loaded on the module's behalf. | ||||
511 | |||||
512 | Note: The list C<require> returns has originated from your current | ||||
513 | perl and your current install. | ||||
514 | |||||
515 | =cut | ||||
516 | |||||
517 | sub requires { | ||||
518 | my $who = shift; | ||||
519 | |||||
520 | unless( check_install( module => $who ) ) { | ||||
521 | warn loc(q[You do not have module '%1' installed], $who) if $VERBOSE; | ||||
522 | return undef; | ||||
523 | } | ||||
524 | |||||
525 | local @INC = @INC[0..$#INC-1] if $FORCE_SAFE_INC && $INC[-1] eq '.'; | ||||
526 | |||||
527 | my $lib = join " ", map { qq["-I$_"] } @INC; | ||||
528 | my $oneliner = 'print(join(qq[\n],map{qq[BONG=$_]}keys(%INC)),qq[\n])'; | ||||
529 | my $cmd = join '', qq["$^X" $lib -M$who -e], QUOTE, $oneliner, QUOTE; | ||||
530 | |||||
531 | return sort | ||||
532 | grep { !/^$who$/ } | ||||
533 | map { chomp; s|/|::|g; $_ } | ||||
534 | grep { s|\.pm$||i; } | ||||
535 | map { s!^BONG\=!!; $_ } | ||||
536 | grep { m!^BONG\=! } | ||||
537 | `$cmd`; | ||||
538 | } | ||||
539 | |||||
540 | 1 | 2µs | 1; | ||
541 | |||||
542 | __END__ |