From: Stevan Little <stevan.little@iinteractive.com>
Date: Wed, 12 Dec 2007 22:09:45 +0000 (+0000)
Subject: Moose taking advantage of the XS
X-Git-Tag: 0_33~2
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=53dd42d80a04479722d4ba00de03fdbe26a12df6;p=gitmo%2FMoose.git

Moose taking advantage of the XS
---

diff --git a/lib/Moose.pm b/lib/Moose.pm
index cf44a30..b81aa74 100644
--- a/lib/Moose.pm
+++ b/lib/Moose.pm
@@ -10,7 +10,6 @@ our $AUTHORITY = 'cpan:STEVAN';
 use Scalar::Util 'blessed', 'reftype';
 use Carp         'confess';
 use Sub::Name    'subname';
-use B            'svref_2object';
 
 use Sub::Exporter;
 
@@ -213,8 +212,7 @@ use Moose::Util::TypeConstraints;
                 my $keyword = \&{ $class . '::' . $name };
 
                 # make sure it is from Moose
-                my $pkg_name =
-                  eval { svref_2object($keyword)->GV->STASH->NAME };
+                my ($pkg_name) = Class::MOP::get_code_info($keyword);
                 next if $@;
                 next if $pkg_name ne 'Moose';
 
diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm
index 6643307..8f25e1d 100644
--- a/lib/Moose/Meta/Class.pm
+++ b/lib/Moose/Meta/Class.pm
@@ -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()) {
+        return $self->{'%!methods'};
+    }
+
     my $map  = $self->{'%!methods'};
 
     my $class_name       = $self->name;
@@ -122,15 +127,14 @@ 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') 
+        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 
+            # 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) }
@@ -139,8 +143,9 @@ sub get_method_map {
             #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);
@@ -210,13 +215,13 @@ sub add_augment_method_modifier {
         my @args = @_;
         no warnings 'redefine';
         if ($Moose::INNER_SLOT{$_super_package}) {
-            local *{$Moose::INNER_SLOT{$_super_package}} = sub { 
-                local *{$Moose::INNER_SLOT{$_super_package}} = sub {}; 
+            local *{$Moose::INNER_SLOT{$_super_package}} = sub {
+                local *{$Moose::INNER_SLOT{$_super_package}} = sub {};
                 $method->(@args);
             };
             return $super->(@args);
-        } 
-        else {          
+        }
+        else {
             return $super->(@args);
         }
     });
diff --git a/lib/Moose/Meta/Role.pm b/lib/Moose/Meta/Role.pm
index 4506c90..9203d13 100644
--- a/lib/Moose/Meta/Role.pm
+++ b/lib/Moose/Meta/Role.pm
@@ -7,7 +7,6 @@ use metaclass;
 
 use Carp         'confess';
 use Scalar::Util 'blessed';
-use B            'svref_2object';
 
 our $VERSION   = '0.10';
 our $AUTHORITY = 'cpan:STEVAN';
@@ -283,8 +282,10 @@ sub method_metaclass { 'Moose::Meta::Role::Method' }
 sub get_method_map {    
     my $self = shift;
     $self->{'%!methods'} ||= {}; 
+    $self->{'$!_package_cache_flag'} = undef;
     $self->Moose::Meta::Class::get_method_map() 
 }
+sub reset_package_cache_flag { () }
 
 # FIXME:
 # Yes, this is a really really UGLY hack
@@ -337,6 +338,10 @@ sub apply {
 
     $self->_apply_attributes($other);         
     $self->_apply_methods($other);   
+    
+    # NOTE:
+    # we need a clear cache flag too ...
+    $other->{'$!_package_cache_flag'} = undef;    
 
     $self->_apply_override_method_modifiers($other);                  
     $self->_apply_before_method_modifiers($other);                  
@@ -558,7 +563,7 @@ sub _apply_override_method_modifiers {
                 # so that we can tell the class were to 
                 # find the right super() method
                 my $method = $self->get_override_method_modifier($method_name);
-                my $package = svref_2object($method)->GV->STASH->NAME;
+                my ($package) = Class::MOP::get_code_info($method);
                 # if it is a class, we just add it
                 $other->add_override_method_modifier($method_name, $method, $package);
             }
@@ -663,6 +668,8 @@ probably not that much really).
 
 =item B<get_method_map>
 
+=item B<reset_package_cache_flag>
+
 =back
 
 =over 4
diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm
index 365c6e6..77895fe 100644
--- a/lib/Moose/Util/TypeConstraints.pm
+++ b/lib/Moose/Util/TypeConstraints.pm
@@ -6,7 +6,6 @@ use warnings;
 
 use Carp         'confess';
 use Scalar::Util 'blessed', 'reftype';
-use B            'svref_2object';
 use Sub::Exporter;
 
 our $VERSION   = '0.17';
@@ -72,7 +71,7 @@ sub unimport {
             my $keyword = \&{$class . '::' . $name};
 
             # make sure it is from Moose
-            my $pkg_name = eval { svref_2object($keyword)->GV->STASH->NAME };
+            my ($pkg_name) = Class::MOP::get_code_info($keyword);
             next if $@;
             next if $pkg_name ne 'Moose::Util::TypeConstraints';