capture less in accessors

[gitmo/Moose.git] / lib / Moose / Meta / Class.pm

diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm
index 092f641..2e1759b 100644 (file)
--- a/lib/Moose/Meta/Class.pm
+++ b/lib/Moose/Meta/Class.pm
@@ -9,7 +9,7 @@ use Class::MOP;
 use Carp         'confess';
 use Scalar::Util 'weaken', 'blessed', 'reftype';
 
-our $VERSION   = '0.14';
+our $VERSION   = '0.17';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use Moose::Meta::Method::Overriden;
@@ -104,11 +104,16 @@ sub construct_instance {
     return $instance;
 }
 
-
 # FIXME:
 # This is ugly
 sub get_method_map {
     my $self = shift;
+
+    if (defined $self->{'$!_package_cache_flag'} &&
+                $self->{'$!_package_cache_flag'} == Class::MOP::check_package_cache_flag($self->meta->name)) {
+        return $self->{'%!methods'};
+    }
+
     my $map  = $self->{'%!methods'};
 
     my $class_name       = $self->name;
@@ -122,16 +127,25 @@ sub get_method_map {
                 defined $map->{$symbol} &&
                         $map->{$symbol}->body == $code;
 
-        my $gv = B::svref_2object($code)->GV;
+        my ($pkg, $name) = Class::MOP::get_code_info($code);
 
-        my $pkg = $gv->STASH->NAME;
-        if ($pkg->can('meta') && $pkg->meta && $pkg->meta->isa('Moose::Meta::Role')) {
+        if ($pkg->can('meta')
+            # NOTE:
+            # we don't know what ->meta we are calling
+            # here, so we need to be careful cause it
+            # just might blow up at us, or just complain
+            # loudly (in the case of Curses.pm) so we
+            # just be a little overly cautious here.
+            # - SL
+            && eval { no warnings; blessed($pkg->meta) }
+            && $pkg->meta->isa('Moose::Meta::Role')) {
             #my $role = $pkg->meta->name;
             #next unless $self->does_role($role);
         }
         else {
-            next if ($gv->STASH->NAME || '') ne $class_name &&
-                    ($gv->NAME        || '') ne '__ANON__';
+            next if ($pkg  || '') ne $class_name &&
+                    ($name || '') ne '__ANON__';
+
         }
 
         $map->{$symbol} = $method_metaclass->wrap($code);
@@ -171,11 +185,10 @@ sub add_override_method_modifier {
         my @args = @_;
         no warnings 'redefine';
         if ($Moose::SUPER_SLOT{$_super_package}) {
-          local *{$Moose::SUPER_SLOT{$_super_package}}
-            = sub { $super->(@args) };
-          return $method->(@args);
+            local *{$Moose::SUPER_SLOT{$_super_package}} = sub { $super->body->(@args) };
+            return $method->(@args);
         } else {
-          confess "Trying to call override modifier'd method without super()";
+            confess "Trying to call override modifier'd method without super()";
         }
     }));
 }
@@ -202,11 +215,14 @@ sub add_augment_method_modifier {
         my @args = @_;
         no warnings 'redefine';
         if ($Moose::INNER_SLOT{$_super_package}) {
-          local *{$Moose::INNER_SLOT{$_super_package}}
-            = sub { $method->(@args) };
-          return $super->(@args);
-        } else {
-          return $super->(@args);
+            local *{$Moose::INNER_SLOT{$_super_package}} = sub {
+                local *{$Moose::INNER_SLOT{$_super_package}} = sub {};
+                $method->(@args);
+            };
+            return $super->body->(@args);
+        }
+        else {
+            return $super->body->(@args);
         }
     });
 }
@@ -482,7 +498,7 @@ Stevan Little E<lt>stevan@iinteractive.comE<gt>
 
 =head1 COPYRIGHT AND LICENSE
 
-Copyright 2006, 2007 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
 
 L<http://www.iinteractive.com>