Filename | /usr/share/perl/5.10/autouse.pm |
Statements | Executed 22 statements in 629µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 44µs | 136µs | import | autouse::
1 | 1 | 1 | 31µs | 31µs | BEGIN@4 | autouse::
1 | 1 | 1 | 24µs | 28µs | vet_import | autouse::
1 | 1 | 1 | 17µs | 41µs | BEGIN@56 | autouse::
2 | 2 | 1 | 8µs | 8µs | CORE:subst (opcode) | autouse::
0 | 0 | 0 | 0s | 0s | __ANON__[:62] | autouse::
0 | 0 | 0 | 0s | 0s | croak | autouse::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package autouse; | ||||
2 | |||||
3 | #use strict; # debugging only | ||||
4 | 3 | 335µs | 1 | 31µs | # spent 31µs within autouse::BEGIN@4 which was called:
# once (31µs+0s) by C4::Koha::BEGIN@31 at line 4 # spent 31µs making 1 call to autouse::BEGIN@4 |
5 | |||||
6 | 1 | 600ns | $autouse::VERSION = '1.06'; | ||
7 | |||||
8 | 1 | 600ns | $autouse::DEBUG ||= 0; | ||
9 | |||||
10 | sub vet_import ($); | ||||
11 | |||||
12 | sub croak { | ||||
13 | require Carp; | ||||
14 | Carp::croak(@_); | ||||
15 | } | ||||
16 | |||||
17 | # spent 136µs (44+92) within autouse::import which was called:
# once (44µs+92µs) by C4::Koha::BEGIN@31 at line 31 of /usr/share/koha/lib/C4/Koha.pm | ||||
18 | 6 | 26µs | my $class = @_ ? shift : 'autouse'; | ||
19 | croak "usage: use $class MODULE [,SUBS...]" unless @_; | ||||
20 | my $module = shift; | ||||
21 | |||||
22 | 1 | 6µs | (my $pm = $module) =~ s{::}{/}g; # spent 6µs making 1 call to autouse::CORE:subst | ||
23 | $pm .= '.pm'; | ||||
24 | 3 | 16µs | if (exists $INC{$pm}) { | ||
25 | 1 | 28µs | vet_import $module; # spent 28µs making 1 call to autouse::vet_import | ||
26 | local $Exporter::ExportLevel = $Exporter::ExportLevel + 1; | ||||
27 | # $Exporter::Verbose = 1; | ||||
28 | 2 | 9µs | 2 | 57µs | return $module->import(map { (my $f = $_) =~ s/\(.*?\)$//; $f } @_); # spent 56µs making 1 call to Exporter::import
# spent 2µs making 1 call to autouse::CORE:subst |
29 | } | ||||
30 | |||||
31 | # It is not loaded: need to do real work. | ||||
32 | my $callpkg = caller(0); | ||||
33 | print "autouse called from $callpkg\n" if $autouse::DEBUG; | ||||
34 | |||||
35 | my $index; | ||||
36 | for my $f (@_) { | ||||
37 | my $proto; | ||||
38 | $proto = $1 if (my $func = $f) =~ s/\((.*)\)$//; | ||||
39 | |||||
40 | my $closure_import_func = $func; # Full name | ||||
41 | my $closure_func = $func; # Name inside package | ||||
42 | my $index = rindex($func, '::'); | ||||
43 | if ($index == -1) { | ||||
44 | $closure_import_func = "${callpkg}::$func"; | ||||
45 | } else { | ||||
46 | $closure_func = substr $func, $index + 2; | ||||
47 | croak "autouse into different package attempted" | ||||
48 | unless substr($func, 0, $index) eq $module; | ||||
49 | } | ||||
50 | |||||
51 | my $load_sub = sub { | ||||
52 | unless ($INC{$pm}) { | ||||
53 | require $pm; | ||||
54 | vet_import $module; | ||||
55 | } | ||||
56 | 3 | 209µs | 2 | 64µs | # spent 41µs (17+24) within autouse::BEGIN@56 which was called:
# once (17µs+24µs) by C4::Koha::BEGIN@31 at line 56 # spent 41µs making 1 call to autouse::BEGIN@56
# spent 24µs making 1 call to warnings::unimport |
57 | *$closure_import_func = \&{"${module}::$closure_func"}; | ||||
58 | print "autousing $module; " | ||||
59 | ."imported $closure_func as $closure_import_func\n" | ||||
60 | if $autouse::DEBUG; | ||||
61 | goto &$closure_import_func; | ||||
62 | }; | ||||
63 | |||||
64 | if (defined $proto) { | ||||
65 | *$closure_import_func = eval "sub ($proto) { goto &\$load_sub }" | ||||
66 | || die; | ||||
67 | } else { | ||||
68 | *$closure_import_func = $load_sub; | ||||
69 | } | ||||
70 | } | ||||
71 | } | ||||
72 | |||||
73 | # spent 28µs (24+4) within autouse::vet_import which was called:
# once (24µs+4µs) by autouse::import at line 25 | ||||
74 | 2 | 29µs | my $module = shift; | ||
75 | 1 | 4µs | if (my $import = $module->can('import')) { # spent 4µs making 1 call to UNIVERSAL::can | ||
76 | croak "autoused module $module has unique import() method" | ||||
77 | unless defined(&Exporter::import) | ||||
78 | && ($import == \&Exporter::import || | ||||
79 | $import == \&UNIVERSAL::import) | ||||
80 | } | ||||
81 | } | ||||
82 | |||||
83 | 1 | 4µs | 1; | ||
84 | |||||
85 | __END__ | ||||
sub autouse::CORE:subst; # opcode |