X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FC3.pm;h=c5a720cbcc8cfb5283a52054908dec84171f127f;hb=ff168601b6fb63af7716f6da5c21e34053660f8a;hp=a2f4740a0bd9158341609ab9aed04f3dd24a538e;hpb=322a5920b5c506789a9daf817374fd9f0df20ab5;p=gitmo%2FClass-C3.git diff --git a/lib/Class/C3.pm b/lib/Class/C3.pm index a2f4740..c5a720c 100644 --- a/lib/Class/C3.pm +++ b/lib/Class/C3.pm @@ -7,7 +7,7 @@ use warnings; use Scalar::Util 'blessed'; use Algorithm::C3; -our $VERSION = '0.12'; +our $VERSION = '0.14'; # this is our global stash of both # MRO's and method dispatch tables @@ -28,6 +28,7 @@ our %MRO; # use these for debugging ... sub _dump_MRO_table { %MRO } our $TURN_OFF_C3 = 0; +our $_initialized = 0; sub import { my $class = caller(); @@ -45,9 +46,14 @@ sub import { sub initialize { # why bother if we don't have anything ... return unless keys %MRO; + if($_initialized) { + uninitialize(); + $MRO{$_} = undef foreach keys %MRO; + } _calculate_method_dispatch_tables(); _apply_method_dispatch_tables(); %next::METHOD_CACHE = (); + $_initialized = 1; } sub uninitialize { @@ -55,27 +61,24 @@ sub uninitialize { return unless keys %MRO; _remove_method_dispatch_tables(); %next::METHOD_CACHE = (); + $_initialized = 0; } -sub reinitialize { - uninitialize(); - # clean up the %MRO before we re-initialize - $MRO{$_} = undef foreach keys %MRO; - initialize(); -} +sub reinitialize { goto &initialize } ## functions for applying C3 to classes sub _calculate_method_dispatch_tables { + my %merge_cache; foreach my $class (keys %MRO) { - _calculate_method_dispatch_table($class); + _calculate_method_dispatch_table($class, \%merge_cache); } } sub _calculate_method_dispatch_table { - my $class = shift; + my ($class, $merge_cache) = @_; no strict 'refs'; - my @MRO = calculateMRO($class); + my @MRO = calculateMRO($class, $merge_cache); $MRO{$class} = { MRO => \@MRO }; my $has_overload_fallback = 0; my %methods; @@ -139,11 +142,11 @@ sub _remove_method_dispatch_table { ## functions for calculating C3 MRO sub calculateMRO { - my ($class) = @_; + my ($class, $merge_cache) = @_; return Algorithm::C3::merge($class, sub { no strict 'refs'; @{$_[0] . '::ISA'}; - }); + }, $merge_cache); } package # hide me from PAUSE @@ -158,8 +161,10 @@ our $VERSION = '0.05'; our %METHOD_CACHE; -sub _find { - my $level = 2; +sub method { + 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); @@ -172,7 +177,7 @@ sub _find { my $self = $_[0]; my $class = blessed($self) || $self; - return $METHOD_CACHE{"$class|$caller|$label"} ||= do { + my $method = $METHOD_CACHE{"$class|$caller|$label"} ||= do { my @MRO = Class::C3::calculateMRO($class); @@ -189,15 +194,27 @@ sub _find { last if (defined ($found = *{$class . '::' . $label}{CODE})); } - die "No next::method '$label' found for $_[0]" if $_[1] && !$found; - $found; }; + + return $method if $indirect; + + die "No next::method '$label' found for $self" if !$method; + + goto &{$method}; } -sub method { goto &{_find($_[0], 1)} } +sub can { method($_[0]) } -sub can { return _find($_[0], 0) ? 1 : 0 } +package # hide me from PAUSE + maybe::next; + +use strict; +use warnings; + +our $VERSION = '0.01'; + +sub method { (next::method($_[0]) || return)->(@_) } 1; @@ -343,7 +360,9 @@ any other users other than the L folks). The simplest solution of c your own INIT method which calls this function. NOTE: -This can B be used to re-load the dispatch tables for all classes. Use C for that. + +If C detects that C has already been executed, it will L and +clear the MRO cache first. =item B @@ -352,11 +371,7 @@ style dispatch order (depth-first, left-to-right). =item B -This effectively calls C followed by C the result of which is a reloading of -B the calculated C3 dispatch tables. - -It should be noted that if you have a large class library, this could potentially be a rather costly -operation. +This is an alias for L above. =back @@ -406,6 +421,10 @@ You can use C to see if C will succeed before you call $self->next::method(@_) if $self->next::can; +Additionally, you can use C as a shortcut to only call the next method if it exists. +The previous example could be simply written as: + + $self->maybe::next::method(@_); There are some caveats about using C, see below for those. @@ -534,6 +553,9 @@ and finding many bugs and providing fixes. =item Thanks to Justin Guenther for making C more robust by handling calls inside C and anon-subs. +=item Thanks to Robert Norris for adding support for C and +C. + =back =head1 AUTHOR @@ -549,4 +571,4 @@ L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. -=cut \ No newline at end of file +=cut