lib/Class/C3/next.pm

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