lib/Class/C3/next.pm

   1 package  # hide me from PAUSE
   2     next;
   3
   4 use strict;
   5 use warnings;
   6 no warnings 'redefine'; # for 00load.t w/ core support
   7
   8 use Scalar::Util 'blessed';
   9
  10 our $VERSION = '0.06';
  11
  12 our %METHOD_CACHE;
  13
  14 sub method {
  15     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         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 sub can { method($_[0]) }
  61
  62 package  # hide me from PAUSE
  63     maybe::next;
  64
  65 use strict;
  66 use warnings;
  67 no warnings 'redefine'; # for 00load.t w/ core support
  68
  69 our $VERSION = '0.02';
  70
  71 sub method { (next::method($_[0]) || return)->(@_) }
  72
  73 1;
  74
  75 __END__
  76
  77 =pod
  78
  79 =head1 NAME
  80
  81 Class::C3::next - Pure-perl next::method and friends
  82
  83 =head1 DESCRIPTION
  84
  85 This module is used internally by L<Class::C3> when
  86 neccesary, and shouldn't be used (or required in
  87 distribution dependencies) directly.  It
  88 defines C<next::method>, C<next::can>, and
  89 C<maybe::next::method> in pure perl.
  90
  91 =head1 AUTHOR
  92
  93 Stevan Little, E<lt>stevan@iinteractive.comE<gt>
  94
  95 Brandon L. Black, E<lt>blblack@gmail.comE<gt>
  96
  97 =head1 COPYRIGHT AND LICENSE
  98
  99 Copyright 2005, 2006 by Infinity Interactive, Inc.
 100
 101 L<http://www.iinteractive.com>
 102
 103 This library is free software; you can redistribute it and/or modify
 104 it under the same terms as Perl itself.
 105
 106 =cut