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;
  72
  73 __END__
  74
  75 =pod
  76
  77 =head1 NAME
  78
  79 Class::C3::next - Pure-perl next::method and friends
  80
  81 =head1 DESCRIPTION
  82
  83 This module is used internally by L<Class::C3> when
  84 neccesary, and shouldn't be used (or required in
  85 distribution dependencies) directly.  It
  86 defines C<next::method>, C<next::can>, and
  87 C<maybe::next::method> in pure perl.
  88
  89 =head1 AUTHOR
  90
  91 Stevan Little, E<lt>stevan@iinteractive.comE<gt>
  92
  93 Brandon L. Black, E<lt>blblack@gmail.comE<gt>
  94
  95 =head1 COPYRIGHT AND LICENSE
  96
  97 Copyright 2005, 2006 by Infinity Interactive, Inc.
  98
  99 L<http://www.iinteractive.com>
 100
 101 This library is free software; you can redistribute it and/or modify
 102 it under the same terms as Perl itself.
 103
 104 =cut