File Coverage

blib/lib/Class/C3/next.pm
Criterion Covered Total %
statement 9 10 90.0
branch n/a
condition 0 2 0.0
subroutine 8 11 72.7
pod n/a
total 17 23 73.9


line stmt bran cond sub pod time code
1             package # hide me from PAUSE
2             next;
3              
4       1     use strict;
5       1     use warnings;
6       1     no warnings 'redefine'; # for 00load.t w/ core support
7              
8       1     use Scalar::Util 'blessed';
9              
10             our $VERSION = '0.35';
11              
12             our %METHOD_CACHE;
13              
14             sub method {
15       0     my $self = $_[0];
16             my $class = blessed($self) || $self;
17             my $indirect = caller() =~ /^(?:next|maybe::next)$/;
18             my $level = $indirect ? 2 : 1;
19              
20             my ($method_caller, $label, @label);
21             while ($method_caller = (caller($level++))[3]) {
22             @label = (split '::', $method_caller);
23             $label = pop @label;
24             last unless
25             $label eq '(eval)' ||
26             $label eq '__ANON__';
27             }
28              
29             my $method;
30              
31             my $caller = join '::' => @label;
32              
33             $method = $METHOD_CACHE{"$class|$caller|$label"} ||= do {
34              
35             my @MRO = Class::C3::calculateMRO($class);
36              
37             my $current;
38             while ($current = shift @MRO) {
39             last if $caller eq $current;
40             }
41              
42       1     no strict 'refs';
43             my $found;
44             foreach my $class (@MRO) {
45             next if (defined $Class::C3::MRO{$class} &&
46             defined $Class::C3::MRO{$class}{methods}{$label});
47             last if (defined ($found = *{$class . '::' . $label}{CODE}));
48             }
49              
50             $found;
51             };
52              
53             return $method if $indirect;
54              
55             die "No next::method '$label' found for $self" if !$method;
56              
57             goto &{$method};
58             }
59              
60       0     sub can { method($_[0]) }
61              
62             package # hide me from PAUSE
63             maybe::next;
64              
65 1     1   7 use strict;
  1         2  
  1         21  
66 1     1   4 use warnings;
  1         2  
  1         38  
67 1     1   6 no warnings 'redefine'; # for 00load.t w/ core support
  1         2  
  1         113  
68              
69             our $VERSION = '0.35';
70              
71 0   0 0     sub method { (next::method($_[0]) || return)->(@_) }
72              
73             1;
74              
75             __END__