0.10
[gitmo/Class-C3.git] / lib / Class / C3.pm
index 6ca3999..78b420f 100644 (file)
@@ -6,7 +6,7 @@ use warnings;
 
 use Scalar::Util 'blessed';
 
-our $VERSION = '0.06';
+our $VERSION = '0.10';
 
 # this is our global stash of both 
 # MRO's and method dispatch tables
@@ -22,7 +22,7 @@ our $VERSION = '0.06';
 #      has_overload_fallback => (1 | 0)
 #   }
 #
-my %MRO;
+our %MRO;
 
 # use these for debugging ...
 sub _dump_MRO_table { %MRO }
@@ -36,7 +36,7 @@ sub import {
     return if $TURN_OFF_C3;
     # make a note to calculate $class 
     # during INIT phase
-    $MRO{$class} = undef;
+    $MRO{$class} = undef unless exists $MRO{$class};
 }
 
 ## initializers
@@ -139,7 +139,9 @@ sub _remove_method_dispatch_table {
     no strict 'refs';
     delete ${"${class}::"}{"()"} if $MRO{$class}->{has_overload_fallback};    
     foreach my $method (keys %{$MRO{$class}->{methods}}) {
-        delete ${"${class}::"}{$method};
+        delete ${"${class}::"}{$method}
+            if defined *{"${class}::${method}"}{CODE} && 
+               (*{"${class}::${method}"}{CODE} eq $MRO{$class}->{methods}->{$method}->{code});       
     }   
 }
 
@@ -169,7 +171,7 @@ sub _merge {
                 # jump out as soon as we find one matching
                 # there is no reason not too. However, if 
                 # we find one, then just remove the '&& last'
-                $nothead++ && last if exists $in_tail{$cand};      
+                ++$nothead && last if exists $in_tail{$cand};      
             }
             last unless $nothead; # leave the loop with our canidate ...
             $reject = $cand;
@@ -205,13 +207,20 @@ use warnings;
 
 use Scalar::Util 'blessed';
 
-our $VERSION = '0.03';
+our $VERSION = '0.05';
 
 our %METHOD_CACHE;
 
 sub method {
-    my @label    = (split '::', (caller(1))[3]);
-    my $label    = pop @label;
+    my $level = 1;
+    my ($method_caller, $label, @label);
+    while ($method_caller = (caller($level++))[3]) {
+      @label = (split '::', $method_caller);
+      $label = pop @label;
+      last unless
+        $label eq '(eval)' ||
+        $label eq '__ANON__';
+    }
     my $caller   = join '::' => @label;    
     my $self     = $_[0];
     my $class    = blessed($self) || $self;
@@ -228,6 +237,8 @@ sub method {
       no strict 'refs';
       my $found;
       foreach my $class (@MRO) {
+          next if (defined $Class::C3::MRO{$class} && 
+                   defined $Class::C3::MRO{$class}{methods}{$label});          
           last if (defined ($found = *{$class . '::' . $label}{CODE}));
       }
 
@@ -463,14 +474,15 @@ You can never have enough tests :)
 
 =head1 CODE COVERAGE
 
-I use B<Devel::Cover> to test the code coverage of my tests, below is the B<Devel::Cover> report on this module's test suite.
+I use B<Devel::Cover> to test the code coverage of my tests, below is the B<Devel::Cover> report on this 
+module's test suite.
 
  ---------------------------- ------ ------ ------ ------ ------ ------ ------
  File                           stmt   bran   cond    sub    pod   time  total
  ---------------------------- ------ ------ ------ ------ ------ ------ ------
- Class/C3.pm                    99.2   93.3   66.7   96.0  100.0   92.8   96.3
+ Class/C3.pm                    98.6   90.9   73.3   96.0  100.0   96.8   95.3
  ---------------------------- ------ ------ ------ ------ ------ ------ ------
- Total                          99.2   93.3   66.7   96.0  100.0   92.8   96.3
+ Total                          98.6   90.9   73.3   96.0  100.0   96.8   95.3
  ---------------------------- ------ ------ ------ ------ ------ ------ ------
 
 =head1 SEE ALSO
@@ -519,13 +531,25 @@ I use B<Devel::Cover> to test the code coverage of my tests, below is the B<Deve
 
 =back 
 
+=head1 ACKNOWLEGEMENTS
+
+=over 4
+
+=item Thanks to Matt S. Trout for using this module in his module L<DBIx::Class> 
+and finding many bugs and providing fixes.
+
+=item Thanks to Justin Guenther for making C<next::method> more robust by handling 
+calls inside C<eval> and anon-subs.
+
+=back
+
 =head1 AUTHOR
 
 Stevan Little, E<lt>stevan@iinteractive.comE<gt>
 
 =head1 COPYRIGHT AND LICENSE
 
-Copyright 2005 by Infinity Interactive, Inc.
+Copyright 2005, 2006 by Infinity Interactive, Inc.
 
 L<http://www.iinteractive.com>