| 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 | Module::Load::Conditional::BEGIN@14 |
| 1 | 1 | 1 | 691µs | 845µs | Module::Load::Conditional::BEGIN@12 |
| 1 | 1 | 1 | 643µs | 704µs | Module::Load::Conditional::BEGIN@5 |
| 1 | 1 | 1 | 9µs | 9µs | Module::Load::Conditional::BEGIN@20 |
| 1 | 1 | 1 | 8µs | 9µs | Module::Load::Conditional::BEGIN@3 |
| 1 | 1 | 1 | 6µs | 39µs | Module::Load::Conditional::BEGIN@16 |
| 1 | 1 | 1 | 6µs | 11µs | Module::Load::Conditional::BEGIN@196 |
| 1 | 1 | 1 | 5µs | 17µs | Module::Load::Conditional::BEGIN@323 |
| 1 | 1 | 1 | 4µs | 16µs | Module::Load::Conditional::BEGIN@6 |
| 1 | 1 | 1 | 4µs | 12µs | Module::Load::Conditional::BEGIN@23 |
| 1 | 1 | 1 | 4µs | 20µs | Module::Load::Conditional::BEGIN@17 |
| 1 | 1 | 1 | 4µs | 51µs | Module::Load::Conditional::BEGIN@21 |
| 1 | 1 | 1 | 4µs | 18µs | Module::Load::Conditional::BEGIN@18 |
| 1 | 1 | 1 | 3µs | 92µs | Module::Load::Conditional::BEGIN@7 |
| 1 | 1 | 1 | 2µs | 2µs | Module::Load::Conditional::BEGIN@10 |
| 1 | 1 | 1 | 2µs | 2µs | Module::Load::Conditional::BEGIN@9 |
| 1 | 1 | 1 | 1µs | 1µs | Module::Load::Conditional::BEGIN@11 |
| 0 | 0 | 0 | 0s | 0s | Module::Load::Conditional::__ANON__[:264] |
| 0 | 0 | 0 | 0s | 0s | Module::Load::Conditional::can_load |
| 0 | 0 | 0 | 0s | 0s | Module::Load::Conditional::check_install |
| 0 | 0 | 0 | 0s | 0s | Module::Load::Conditional::requires |
| 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__ |