line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Safe::Isa; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
134317
|
use strict; |
|
2
|
|
|
|
|
12
|
|
|
2
|
|
|
|
|
54
|
|
4
|
2
|
|
|
2
|
|
9
|
use warnings FATAL => 'all'; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
64
|
|
5
|
2
|
|
|
2
|
|
8
|
use Scalar::Util (); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
44
|
|
6
|
2
|
|
|
2
|
|
8
|
use Exporter 5.57 qw(import); |
|
2
|
|
|
|
|
35
|
|
|
2
|
|
|
|
|
420
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
our $VERSION = '1.000008'; |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
our @EXPORT = qw($_call_if_object $_isa $_can $_does $_DOES $_call_if_can); |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our $_call_if_object = sub { |
13
|
|
|
|
|
|
|
my ($obj, $method) = (shift, shift); |
14
|
|
|
|
|
|
|
# This is intentionally a truth test, not a defined test, otherwise |
15
|
|
|
|
|
|
|
# we gratuitously break modules like Scalar::Defer, which would be |
16
|
|
|
|
|
|
|
# un-perlish. |
17
|
|
|
|
|
|
|
return unless Scalar::Util::blessed($obj); |
18
|
|
|
|
|
|
|
return $obj->isa(@_) if lc($method) eq 'does' and not $obj->can($method); |
19
|
|
|
|
|
|
|
return $obj->$method(@_); |
20
|
|
|
|
|
|
|
}; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
our ($_isa, $_can, $_does, $_DOES) = map { |
23
|
|
|
|
|
|
|
my $method = $_; |
24
|
|
|
|
|
|
|
sub { my $obj = shift; $obj->$_call_if_object($method => @_) } |
25
|
|
|
|
|
|
|
} qw(isa can does DOES); |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
our $_call_if_can = sub { |
28
|
|
|
|
|
|
|
my ($obj, $method) = (shift, shift); |
29
|
|
|
|
|
|
|
return unless $obj->$_call_if_object(can => $method); |
30
|
|
|
|
|
|
|
return $obj->$method(@_); |
31
|
|
|
|
|
|
|
}; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
1; |
34
|
|
|
|
|
|
|
__END__ |