← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
  Run on Tue Oct 15 17:10:45 2013
Reported on Tue Oct 15 17:12:23 2013

Filename/usr/share/perl/5.10/Module/Load/Conditional.pm
StatementsExecuted 43 statements in 4.07ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1112.68ms12.3msModule::Load::Conditional::::BEGIN@6Module::Load::Conditional::BEGIN@6
111874µs1.27msModule::Load::Conditional::::BEGIN@12Module::Load::Conditional::BEGIN@12
111530µs631µsModule::Load::Conditional::::BEGIN@5Module::Load::Conditional::BEGIN@5
11130µs30µsModule::Load::Conditional::::BEGIN@16Module::Load::Conditional::BEGIN@16
11128µs54µsModule::Load::Conditional::::BEGIN@187Module::Load::Conditional::BEGIN@187
11125µs293µsModule::Load::Conditional::::BEGIN@17Module::Load::Conditional::BEGIN@17
11123µs129µsModule::Load::Conditional::::BEGIN@14Module::Load::Conditional::BEGIN@14
11123µs67µsModule::Load::Conditional::::BEGIN@19Module::Load::Conditional::BEGIN@19
11121µs251µsModule::Load::Conditional::::BEGIN@7Module::Load::Conditional::BEGIN@7
11121µs28µsModule::Load::Conditional::::BEGIN@3Module::Load::Conditional::BEGIN@3
11110µs10µsModule::Load::Conditional::::BEGIN@10Module::Load::Conditional::BEGIN@10
1119µs9µsModule::Load::Conditional::::BEGIN@9Module::Load::Conditional::BEGIN@9
1119µs9µsModule::Load::Conditional::::BEGIN@11Module::Load::Conditional::BEGIN@11
0000s0sModule::Load::Conditional::::_parse_versionModule::Load::Conditional::_parse_version
0000s0sModule::Load::Conditional::::can_loadModule::Load::Conditional::can_load
0000s0sModule::Load::Conditional::::check_installModule::Load::Conditional::check_install
0000s0sModule::Load::Conditional::::requiresModule::Load::Conditional::requires
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package Module::Load::Conditional;
2
3333µs235µs
# spent 28µs (21+7) within Module::Load::Conditional::BEGIN@3 which was called: # once (21µs+7µs) by C4::Context::BEGIN@108 at line 3
use strict;
# spent 28µs making 1 call to Module::Load::Conditional::BEGIN@3 # spent 7µs making 1 call to strict::import
4
53127µs2650µs
# spent 631µs (530+101) within Module::Load::Conditional::BEGIN@5 which was called: # once (530µs+101µs) by C4::Context::BEGIN@108 at line 5
use Module::Load;
# spent 631µs making 1 call to Module::Load::Conditional::BEGIN@5 # spent 19µs making 1 call to Module::Load::import
63177µs212.4ms
# spent 12.3ms (2.68+9.61) within Module::Load::Conditional::BEGIN@6 which was called: # once (2.68ms+9.61ms) by C4::Context::BEGIN@108 at line 6
use Params::Check qw[check];
# spent 12.3ms making 1 call to Module::Load::Conditional::BEGIN@6 # spent 134µs making 1 call to Exporter::import
7358µs2481µs
# spent 251µs (21+230) within Module::Load::Conditional::BEGIN@7 which was called: # once (21µs+230µs) by C4::Context::BEGIN@108 at line 7
use Locale::Maketext::Simple Style => 'gettext';
# spent 251µs making 1 call to Module::Load::Conditional::BEGIN@7 # spent 230µs making 1 call to Locale::Maketext::Simple::import
8
9346µs19µs
# spent 9µs within Module::Load::Conditional::BEGIN@9 which was called: # once (9µs+0s) by C4::Context::BEGIN@108 at line 9
use Carp ();
# spent 9µs making 1 call to Module::Load::Conditional::BEGIN@9
10345µs110µs
# spent 10µs within Module::Load::Conditional::BEGIN@10 which was called: # once (10µs+0s) by C4::Context::BEGIN@108 at line 10
use File::Spec ();
# spent 10µs making 1 call to Module::Load::Conditional::BEGIN@10
11357µs19µs
# spent 9µs within Module::Load::Conditional::BEGIN@11 which was called: # once (9µs+0s) by C4::Context::BEGIN@108 at line 11
use FileHandle ();
# spent 9µs making 1 call to Module::Load::Conditional::BEGIN@11
123301µs21.30ms
# spent 1.27ms (874µs+395µs) within Module::Load::Conditional::BEGIN@12 which was called: # once (874µs+395µs) by C4::Context::BEGIN@108 at line 12
use version;
# spent 1.27ms making 1 call to Module::Load::Conditional::BEGIN@12 # spent 28µs making 1 call to version::import
13
14390µs2234µs
# spent 129µs (23+105) within Module::Load::Conditional::BEGIN@14 which was called: # once (23µs+105µs) by C4::Context::BEGIN@108 at line 14
use constant ON_VMS => $^O eq 'VMS';
# spent 129µs making 1 call to Module::Load::Conditional::BEGIN@14 # spent 105µs making 1 call to constant::import
15
16
# spent 30µs within Module::Load::Conditional::BEGIN@16 which was called: # once (30µs+0s) by C4::Context::BEGIN@108 at line 26
BEGIN {
17147µs1268µs
# spent 293µs (25+268) within Module::Load::Conditional::BEGIN@17 which was called: # once (25µs+268µs) by C4::Context::BEGIN@108 at line 18
use vars qw[ $VERSION @ISA $VERBOSE $CACHE @EXPORT_OK
# spent 268µs making 1 call to vars::import
18256µs1293µs $FIND_VERSION $ERROR $CHECK_INC_HASH];
# spent 293µs making 1 call to Module::Load::Conditional::BEGIN@17
193111µs2111µs
# spent 67µs (23+44) within Module::Load::Conditional::BEGIN@19 which was called: # once (23µs+44µs) by C4::Context::BEGIN@108 at line 19
use Exporter;
# spent 67µs making 1 call to Module::Load::Conditional::BEGIN@19 # spent 44µs making 1 call to Exporter::import
20116µs @ISA = qw[Exporter];
2111µs $VERSION = '0.30';
221600ns $VERBOSE = 0;
231600ns $FIND_VERSION = 1;
241400ns $CHECK_INC_HASH = 0;
25111µs @EXPORT_OK = qw[check_install can_load requires];
261424µs130µs}
# spent 30µs making 1 call to Module::Load::Conditional::BEGIN@16
27
28=pod
29
- -
143### this checks if a certain module is installed already ###
144### if it returns true, the module in question is already installed
145### or we found the file, but couldn't open it, OR there was no version
146### to be found in the module
147### it will return 0 if the version in the module is LOWER then the one
148### we are looking for, or if we couldn't find the desired module to begin with
149### if the installed version is higher or equal to the one we want, it will return
150### a hashref with he module name and version in it.. so 'true' as well.
151sub check_install {
152 my %hash = @_;
153
154 my $tmpl = {
155 version => { default => '0.0' },
156 module => { required => 1 },
157 verbose => { default => $VERBOSE },
158 };
159
160 my $args;
161 unless( $args = check( $tmpl, \%hash, $VERBOSE ) ) {
162 warn loc( q[A problem occurred checking arguments] ) if $VERBOSE;
163 return;
164 }
165
166 my $file = File::Spec->catfile( split /::/, $args->{module} ) . '.pm';
167 my $file_inc = File::Spec::Unix->catfile(
168 split /::/, $args->{module}
169 ) . '.pm';
170
171 ### where we store the return value ###
172 my $href = {
173 file => undef,
174 version => undef,
175 uptodate => undef,
176 };
177
178 my $filename;
179
180 ### check the inc hash if we're allowed to
181 if( $CHECK_INC_HASH ) {
182 $filename = $href->{'file'} =
183 $INC{ $file_inc } if defined $INC{ $file_inc };
184
185 ### find the version by inspecting the package
186 if( defined $filename && $FIND_VERSION ) {
18732.46ms279µs
# spent 54µs (28+25) within Module::Load::Conditional::BEGIN@187 which was called: # once (28µs+25µs) by C4::Context::BEGIN@108 at line 187
no strict 'refs';
# spent 54µs making 1 call to Module::Load::Conditional::BEGIN@187 # spent 25µs making 1 call to strict::unimport
188 $href->{version} = ${ "$args->{module}"."::VERSION" };
189 }
190 }
191
192 ### we didnt find the filename yet by looking in %INC,
193 ### so scan the dirs
194 unless( $filename ) {
195
196 DIR: for my $dir ( @INC ) {
197
198 my $fh;
199
200 if ( ref $dir ) {
201 ### @INC hook -- we invoke it and get the filehandle back
202 ### this is actually documented behaviour as of 5.8 ;)
203
204 if (UNIVERSAL::isa($dir, 'CODE')) {
205 ($fh) = $dir->($dir, $file);
206
207 } elsif (UNIVERSAL::isa($dir, 'ARRAY')) {
208 ($fh) = $dir->[0]->($dir, $file, @{$dir}{1..$#{$dir}})
209
210 } elsif (UNIVERSAL::can($dir, 'INC')) {
211 ($fh) = $dir->INC->($dir, $file);
212 }
213
214 if (!UNIVERSAL::isa($fh, 'GLOB')) {
215 warn loc(q[Cannot open file '%1': %2], $file, $!)
216 if $args->{verbose};
217 next;
218 }
219
220 $filename = $INC{$file_inc} || $file;
221
222 } else {
223 $filename = File::Spec->catfile($dir, $file);
224 next unless -e $filename;
225
226 $fh = new FileHandle;
227 if (!$fh->open($filename)) {
228 warn loc(q[Cannot open file '%1': %2], $file, $!)
229 if $args->{verbose};
230 next;
231 }
232 }
233
234 ### store the directory we found the file in
235 $href->{dir} = $dir;
236
237 ### files need to be in unix format under vms,
238 ### or they might be loaded twice
239 $href->{file} = ON_VMS
240 ? VMS::Filespec::unixify( $filename )
241 : $filename;
242
243 ### user wants us to find the version from files
244 if( $FIND_VERSION ) {
245
246 my $in_pod = 0;
247 while ( my $line = <$fh> ) {
248
249 ### stolen from EU::MM_Unix->parse_version to address
250 ### #24062: "Problem with CPANPLUS 0.076 misidentifying
251 ### versions after installing Text::NSP 1.03" where a
252 ### VERSION mentioned in the POD was found before
253 ### the real $VERSION declaration.
254 $in_pod = $line =~ /^=(?!cut)/ ? 1 :
255 $line =~ /^=cut/ ? 0 :
256 $in_pod;
257 next if $in_pod;
258
259 ### try to find a version declaration in this string.
260 my $ver = __PACKAGE__->_parse_version( $line );
261
262 if( defined $ver ) {
263 $href->{version} = $ver;
264
265 last DIR;
266 }
267 }
268 }
269 }
270 }
271
272 ### if we couldn't find the file, return undef ###
273 return unless defined $href->{file};
274
275 ### only complain if we're expected to find a version higher than 0.0 anyway
276 if( $FIND_VERSION and not defined $href->{version} ) {
277 { ### don't warn about the 'not numeric' stuff ###
278 local $^W;
279
280 ### if we got here, we didn't find the version
281 warn loc(q[Could not check version on '%1'], $args->{module} )
282 if $args->{verbose} and $args->{version} > 0;
283 }
284 $href->{uptodate} = 1;
285
286 } else {
287 ### don't warn about the 'not numeric' stuff ###
288 local $^W;
289
290 ### use qv(), as it will deal with developer release number
291 ### ie ones containing _ as well. This addresses bug report
292 ### #29348: Version compare logic doesn't handle alphas?
293 ###
294 ### Update from JPeacock: apparently qv() and version->new
295 ### are different things, and we *must* use version->new
296 ### here, or things like #30056 might start happening
297 $href->{uptodate} =
298 version->new( $args->{version} ) <= version->new( $href->{version} )
299 ? 1
300 : 0;
301 }
302
303 return $href;
304}
305
306sub _parse_version {
307 my $self = shift;
308 my $str = shift or return;
309 my $verbose = shift or 0;
310
311 ### skip commented out lines, they won't eval to anything.
312 return if $str =~ /^\s*#/;
313
314 ### the following regexp & eval statement comes from the
315 ### ExtUtils::MakeMaker source (EU::MM_Unix->parse_version)
316 ### Following #18892, which tells us the original
317 ### regex breaks under -T, we must modifiy it so
318 ### it captures the entire expression, and eval /that/
319 ### rather than $_, which is insecure.
320 my $taint_safe_str = do { $str =~ /(^.*$)/sm; $1 };
321
322 if( $str =~ /(?<!\\)([\$*])(([\w\:\']*)\bVERSION)\b.*\=/ ) {
323
324 print "Evaluating: $str\n" if $verbose;
325
326 ### this creates a string to be eval'd, like:
327 # package Module::Load::Conditional::_version;
328 # no strict;
329 #
330 # local $VERSION;
331 # $VERSION=undef; do {
332 # use version; $VERSION = qv('0.0.3');
333 # }; $VERSION
334
335 my $eval = qq{
336 package Module::Load::Conditional::_version;
337 no strict;
338
339 local $1$2;
340 \$$2=undef; do {
341 $taint_safe_str
342 }; \$$2
343 };
344
345 print "Evaltext: $eval\n" if $verbose;
346
347 my $result = do {
348 local $^W = 0;
349 eval($eval);
350 };
351
352
353 my $rv = defined $result ? $result : '0.0';
354
355 print( $@ ? "Error: $@\n" : "Result: $rv\n" ) if $verbose;
356
357 return $rv;
358 }
359
360 ### unable to find a version in this string
361 return;
362}
363
364=head2 $bool = can_load( modules => { NAME => VERSION [,NAME => VERSION] }, [verbose => BOOL, nocache => BOOL] )
365
- -
402sub can_load {
403 my %hash = @_;
404
405 my $tmpl = {
406 modules => { default => {}, strict_type => 1 },
407 verbose => { default => $VERBOSE },
408 nocache => { default => 0 },
409 };
410
411 my $args;
412
413 unless( $args = check( $tmpl, \%hash, $VERBOSE ) ) {
414 $ERROR = loc(q[Problem validating arguments!]);
415 warn $ERROR if $VERBOSE;
416 return;
417 }
418
419 ### layout of $CACHE:
420 ### $CACHE = {
421 ### $ module => {
422 ### usable => BOOL,
423 ### version => \d,
424 ### file => /path/to/file,
425 ### },
426 ### };
427
428 $CACHE ||= {}; # in case it was undef'd
429
430 my $error;
431 BLOCK: {
432 my $href = $args->{modules};
433
434 my @load;
435 for my $mod ( keys %$href ) {
436
437 next if $CACHE->{$mod}->{usable} && !$args->{nocache};
438
439 ### else, check if the hash key is defined already,
440 ### meaning $mod => 0,
441 ### indicating UNSUCCESSFUL prior attempt of usage
442
443 ### use qv(), as it will deal with developer release number
444 ### ie ones containing _ as well. This addresses bug report
445 ### #29348: Version compare logic doesn't handle alphas?
446 ###
447 ### Update from JPeacock: apparently qv() and version->new
448 ### are different things, and we *must* use version->new
449 ### here, or things like #30056 might start happening
450 if ( !$args->{nocache}
451 && defined $CACHE->{$mod}->{usable}
452 && (version->new( $CACHE->{$mod}->{version}||0 )
453 >= version->new( $href->{$mod} ) )
454 ) {
455 $error = loc( q[Already tried to use '%1', which was unsuccessful], $mod);
456 last BLOCK;
457 }
458
459 my $mod_data = check_install(
460 module => $mod,
461 version => $href->{$mod}
462 );
463
464 if( !$mod_data or !defined $mod_data->{file} ) {
465 $error = loc(q[Could not find or check module '%1'], $mod);
466 $CACHE->{$mod}->{usable} = 0;
467 last BLOCK;
468 }
469
470 map {
471 $CACHE->{$mod}->{$_} = $mod_data->{$_}
472 } qw[version file uptodate];
473
474 push @load, $mod;
475 }
476
477 for my $mod ( @load ) {
478
479 if ( $CACHE->{$mod}->{uptodate} ) {
480
481 eval { load $mod };
482
483 ### in case anything goes wrong, log the error, the fact
484 ### we tried to use this module and return 0;
485 if( $@ ) {
486 $error = $@;
487 $CACHE->{$mod}->{usable} = 0;
488 last BLOCK;
489 } else {
490 $CACHE->{$mod}->{usable} = 1;
491 }
492
493 ### module not found in @INC, store the result in
494 ### $CACHE and return 0
495 } else {
496
497 $error = loc(q[Module '%1' is not uptodate!], $mod);
498 $CACHE->{$mod}->{usable} = 0;
499 last BLOCK;
500 }
501 }
502
503 } # BLOCK
504
505 if( defined $error ) {
506 $ERROR = $error;
507 Carp::carp( loc(q|%1 [THIS MAY BE A PROBLEM!]|,$error) ) if $args->{verbose};
508 return;
509 } else {
510 return 1;
511 }
512}
513
514=back
515
- -
533sub requires {
534 my $who = shift;
535
536 unless( check_install( module => $who ) ) {
537 warn loc(q[You do not have module '%1' installed], $who) if $VERBOSE;
538 return undef;
539 }
540
541 my $lib = join " ", map { qq["-I$_"] } @INC;
542 my $cmd = qq[$^X $lib -M$who -e"print(join(qq[\\n],keys(%INC)))"];
543
544 return sort
545 grep { !/^$who$/ }
546 map { chomp; s|/|::|g; $_ }
547 grep { s|\.pm$||i; }
548 `$cmd`;
549}
550
55117µs1;
552
553__END__
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.