X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FC3%2Fnext.pm;h=c2526e515e4ab3a91928df12ced3793c0a48245a;hb=6e2617b7990c0b84feca6ec69292ffc6b5a1c25b;hp=5f3659978d28943eff3dcc079825071ca90b03aa;hpb=e86d671caff42fa71ea57554fb81d06bb52f45e2;p=gitmo%2FClass-C3.git diff --git a/lib/Class/C3/next.pm b/lib/Class/C3/next.pm index 5f36599..c2526e5 100644 --- a/lib/Class/C3/next.pm +++ b/lib/Class/C3/next.pm @@ -1,12 +1,13 @@ package # hide me from PAUSE - next; + next; use strict; use warnings; +no warnings 'redefine'; # for 00load.t w/ core support use Scalar::Util 'blessed'; -our $VERSION = '0.06'; +our $VERSION = '0.24'; our %METHOD_CACHE; @@ -15,7 +16,7 @@ sub method { my $class = blessed($self) || $self; my $indirect = caller() =~ /^(?:next|maybe::next)$/; my $level = $indirect ? 2 : 1; - + my ($method_caller, $label, @label); while ($method_caller = (caller($level++))[3]) { @label = (split '::', $method_caller); @@ -27,25 +28,25 @@ sub method { my $method; - my $caller = join '::' => @label; - + my $caller = join '::' => @label; + $method = $METHOD_CACHE{"$class|$caller|$label"} ||= do { - + my @MRO = Class::C3::calculateMRO($class); - + my $current; while ($current = shift @MRO) { last if $caller eq $current; } - + no strict 'refs'; my $found; foreach my $class (@MRO) { - next if (defined $Class::C3::MRO{$class} && - defined $Class::C3::MRO{$class}{methods}{$label}); + next if (defined $Class::C3::MRO{$class} && + defined $Class::C3::MRO{$class}{methods}{$label}); last if (defined ($found = *{$class . '::' . $label}{CODE})); } - + $found; }; @@ -59,13 +60,47 @@ sub method { sub can { method($_[0]) } package # hide me from PAUSE - maybe::next; + maybe::next; use strict; use warnings; +no warnings 'redefine'; # for 00load.t w/ core support -our $VERSION = '0.02'; +our $VERSION = '0.24'; sub method { (next::method($_[0]) || return)->(@_) } 1; + +__END__ + +=pod + +=head1 NAME + +Class::C3::next - Pure-perl next::method and friends + +=head1 DESCRIPTION + +This module is used internally by L when +neccesary, and shouldn't be used (or required in +distribution dependencies) directly. It +defines C, C, and +C in pure perl. + +=head1 AUTHOR + +Stevan Little, Estevan@iinteractive.comE + +Brandon L. Black, Eblblack@gmail.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2005, 2006 by Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut