| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package UNIVERSAL::which; |
|
2
|
6
|
|
|
6
|
|
42773
|
use 5.008001; |
|
|
6
|
|
|
|
|
20
|
|
|
|
6
|
|
|
|
|
224
|
|
|
3
|
6
|
|
|
6
|
|
30
|
use strict; |
|
|
6
|
|
|
|
|
11
|
|
|
|
6
|
|
|
|
|
419
|
|
|
4
|
6
|
|
|
6
|
|
27
|
use warnings; |
|
|
6
|
|
|
|
|
13
|
|
|
|
6
|
|
|
|
|
2213
|
|
|
5
|
|
|
|
|
|
|
our $VERSION = sprintf "%d.%02d", q$Revision: 0.6 $ =~ /(\d+)/g; |
|
6
|
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
sub UNIVERSAL::which { |
|
8
|
15
|
|
|
15
|
0
|
3764
|
my ( $self, $method ) = @_; |
|
9
|
15
|
|
|
|
|
272
|
my $coderef = $self->can($method); |
|
10
|
15
|
100
|
|
|
|
58
|
unless ($coderef) { |
|
11
|
3
|
|
|
|
|
8
|
$method = 'AUTOLOAD'; |
|
12
|
3
|
|
|
|
|
29
|
$coderef = $self->can($method); |
|
13
|
|
|
|
|
|
|
} |
|
14
|
15
|
100
|
|
|
|
142
|
return unless UNIVERSAL::isa($coderef, 'CODE'); |
|
15
|
14
|
|
|
|
|
111
|
require B; |
|
16
|
14
|
|
|
|
|
81
|
my $b = B::svref_2object($coderef); |
|
17
|
14
|
|
|
|
|
85
|
my $cvflags = $b->CvFLAGS; |
|
18
|
14
|
|
|
|
|
130
|
my $pkg = $b->GV->STASH->NAME; |
|
19
|
14
|
|
|
|
|
46
|
my $fq = $pkg . '::' . $method; |
|
20
|
14
|
100
|
|
|
|
22
|
if (! defined(&{$fq}) ){ |
|
|
14
|
|
|
|
|
84
|
|
|
21
|
6
|
|
|
|
|
30
|
$method = $b->GV->NAME; |
|
22
|
6
|
|
|
|
|
11
|
$fq = $pkg . '::' . $method; |
|
23
|
6
|
100
|
|
|
|
9
|
$fq = undef unless defined(&{$fq}); # double-check |
|
|
6
|
|
|
|
|
23
|
|
|
24
|
|
|
|
|
|
|
} |
|
25
|
14
|
100
|
|
|
|
123
|
return wantarray ? ( $pkg, $method, $cvflags ) : $fq; |
|
26
|
|
|
|
|
|
|
} |
|
27
|
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
1; |
|
29
|
|
|
|
|
|
|
__END__ |