From: Dave Rolsky <autarch@urth.org>
Date: Wed, 16 Dec 2009 17:52:38 +0000 (-0600)
Subject: Move having methods to a new superclass - Class::MOP::HasMethods
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e3e651fb972d8c9c1cf82574b53dcc8cadfb717a;p=gitmo%2FClass-MOP.git

Move having methods to a new superclass - Class::MOP::HasMethods
---

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index 1076412..2f6263e 100644
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -12,6 +12,7 @@ use Carp          'confess';
 use Scalar::Util  'weaken', 'reftype', 'blessed';
 use Try::Tiny;
 
+use Class::MOP::HasMethods;
 use Class::MOP::Class;
 use Class::MOP::Attribute;
 use Class::MOP::Method;
@@ -160,68 +161,71 @@ sub _is_valid_class_name {
 # inherit them using _construct_instance
 
 ## --------------------------------------------------------
-## Class::MOP::Package
+## Class::MOP::HasMethods
 
-Class::MOP::Package->meta->add_attribute(
-    Class::MOP::Attribute->new('package' => (
+Class::MOP::HasMethods->meta->add_attribute(
+    Class::MOP::Attribute->new('_methods' => (
         reader   => {
-            # NOTE: we need to do this in order
-            # for the instance meta-object to
-            # not fall into meta-circular death
-            #
+            # NOTE:
             # we just alias the original method
             # rather than re-produce it here
-            'name' => \&Class::MOP::Package::name
+            '_full_method_map' => \&Class::MOP::HasMethods::_full_method_map
         },
+        default => sub { {} }
     ))
 );
 
-Class::MOP::Package->meta->add_attribute(
-    Class::MOP::Attribute->new('namespace' => (
-        reader => {
+Class::MOP::HasMethods->meta->add_attribute(
+    Class::MOP::Attribute->new('method_metaclass' => (
+        reader   => {
             # NOTE:
             # we just alias the original method
             # rather than re-produce it here
-            'namespace' => \&Class::MOP::Package::namespace
+            'method_metaclass' => \&Class::MOP::HasMethods::method_metaclass
         },
-        init_arg => undef,
-        default  => sub { \undef }
+        default  => 'Class::MOP::Method',
     ))
 );
 
-Class::MOP::Package->meta->add_attribute(
-    Class::MOP::Attribute->new('_methods' => (
+Class::MOP::HasMethods->meta->add_attribute(
+    Class::MOP::Attribute->new('wrapped_method_metaclass' => (
         reader   => {
             # NOTE:
             # we just alias the original method
             # rather than re-produce it here
-            '_full_method_map' => \&Class::MOP::Package::_full_method_map
+            'wrapped_method_metaclass' => \&Class::MOP::HasMethods::wrapped_method_metaclass
         },
-        default => sub { {} }
+        default  => 'Class::MOP::Method::Wrapped',
     ))
 );
 
+## --------------------------------------------------------
+## Class::MOP::Package
+
 Class::MOP::Package->meta->add_attribute(
-    Class::MOP::Attribute->new('method_metaclass' => (
+    Class::MOP::Attribute->new('package' => (
         reader   => {
-            # NOTE:
+            # NOTE: we need to do this in order
+            # for the instance meta-object to
+            # not fall into meta-circular death
+            #
             # we just alias the original method
             # rather than re-produce it here
-            'method_metaclass' => \&Class::MOP::Package::method_metaclass
+            'name' => \&Class::MOP::Package::name
         },
-        default  => 'Class::MOP::Method',
     ))
 );
 
 Class::MOP::Package->meta->add_attribute(
-    Class::MOP::Attribute->new('wrapped_method_metaclass' => (
-        reader   => {
+    Class::MOP::Attribute->new('namespace' => (
+        reader => {
             # NOTE:
             # we just alias the original method
             # rather than re-produce it here
-            'wrapped_method_metaclass' => \&Class::MOP::Package::wrapped_method_metaclass
+            'namespace' => \&Class::MOP::Package::namespace
         },
-        default  => 'Class::MOP::Method::Wrapped',
+        init_arg => undef,
+        default  => sub { \undef }
     ))
 );
 
@@ -684,6 +688,14 @@ $_->meta->make_immutable(
     Class::MOP::Method::Wrapped
 /;
 
+$_->meta->make_immutable(
+    inline_constructor  => 0,
+    constructor_name    => undef,
+    inline_accessors => 0,
+) for qw/
+    Class::MOP::HasMethods
+/;
+
 1;
 
 __END__
diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 8678844..a486d02 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -1051,6 +1051,8 @@ sub _inline_constructor {
     my ( $self, %args ) = @_;
 
     my $name = $args{constructor_name};
+    # A class may not even have a constructor, and that's okay.
+    return unless defined $name;
 
     if ( $self->has_method($name) && !$args{replace_constructor} ) {
         my $class = $self->name;
diff --git a/lib/Class/MOP/HasMethods.pm b/lib/Class/MOP/HasMethods.pm
new file mode 100644
index 0000000..44579df
--- /dev/null
+++ b/lib/Class/MOP/HasMethods.pm
@@ -0,0 +1,150 @@
+package Class::MOP::HasMethods;
+
+use strict;
+use warnings;
+
+use Scalar::Util 'blessed';
+use Carp         'confess';
+use Sub::Name    'subname';
+
+use base 'Class::MOP::Object';
+
+sub method_metaclass         { $_[0]->{'method_metaclass'}            }
+sub wrapped_method_metaclass { $_[0]->{'wrapped_method_metaclass'}    }
+
+# This doesn't always get initialized in a constructor because there is a
+# weird object construction path for subclasses of Class::MOP::Class. At one
+# point, this always got initialized by calling into the XS code first, but
+# that is no longer guaranteed to happen.
+sub _method_map { $_[0]->{'methods'} ||= {} }
+
+sub wrap_method_body {
+    my ( $self, %args ) = @_;
+
+    ( 'CODE' eq ref $args{body} )
+        || confess "Your code block must be a CODE reference";
+
+    $self->method_metaclass->wrap(
+        package_name => $self->name,
+        %args,
+    );
+}
+
+sub add_method {
+    my ( $self, $method_name, $method ) = @_;
+    ( defined $method_name && length $method_name )
+        || confess "You must define a method name";
+
+    my $body;
+    if ( blessed($method) ) {
+        $body = $method->body;
+        if ( $method->package_name ne $self->name ) {
+            $method = $method->clone(
+                package_name => $self->name,
+                name         => $method_name,
+            ) if $method->can('clone');
+        }
+
+        $method->attach_to_class($self);
+    }
+    else {
+        # If a raw code reference is supplied, its method object is not created.
+        # The method object won't be created until required.
+        $body = $method;
+    }
+
+    $self->_method_map->{$method_name} = $method;
+
+    my ( $current_package, $current_name ) = Class::MOP::get_code_info($body);
+
+    if ( !defined $current_name || $current_name =~ /^__ANON__/ ) {
+        my $full_method_name = ( $self->name . '::' . $method_name );
+        subname( $full_method_name => $body );
+    }
+
+    $self->add_package_symbol(
+        { sigil => '&', type => 'CODE', name => $method_name },
+        $body,
+    );
+}
+
+sub _code_is_mine {
+    my ( $self, $code ) = @_;
+
+    my ( $code_package, $code_name ) = Class::MOP::get_code_info($code);
+
+    return $code_package && $code_package eq $self->name
+        || ( $code_package eq 'constant' && $code_name eq '__ANON__' );
+}
+
+sub has_method {
+    my ( $self, $method_name ) = @_;
+
+    ( defined $method_name && length $method_name )
+        || confess "You must define a method name";
+
+    return defined( $self->get_method($method_name) );
+}
+
+sub get_method {
+    my ( $self, $method_name ) = @_;
+
+    ( defined $method_name && length $method_name )
+        || confess "You must define a method name";
+
+    my $method_map = $self->_method_map;
+    my $map_entry  = $method_map->{$method_name};
+    my $code       = $self->get_package_symbol(
+        {
+            name  => $method_name,
+            sigil => '&',
+            type  => 'CODE',
+        }
+    );
+
+    # This seems to happen in some weird cases where methods modifiers are
+    # added via roles or some other such bizareness. Honestly, I don't totally
+    # understand this, but returning the entry works, and keeps various MX
+    # modules from blowing up. - DR
+    return $map_entry if blessed $map_entry && !$code;
+
+    return $map_entry if blessed $map_entry && $map_entry->body == $code;
+
+    unless ($map_entry) {
+        return unless $code && $self->_code_is_mine($code);
+    }
+
+    $code ||= $map_entry;
+
+    return $method_map->{$method_name} = $self->wrap_method_body(
+        body                 => $code,
+        name                 => $method_name,
+        associated_metaclass => $self,
+    );
+}
+
+sub remove_method {
+    my ( $self, $method_name ) = @_;
+    ( defined $method_name && length $method_name )
+        || confess "You must define a method name";
+
+    my $removed_method = delete $self->_full_method_map->{$method_name};
+
+    $self->remove_package_symbol(
+        { sigil => '&', type => 'CODE', name => $method_name } );
+
+    $removed_method->detach_from_class
+        if $removed_method && blessed $removed_method;
+
+    # still valid, since we just removed the method from the map
+    $self->update_package_cache_flag;
+
+    return $removed_method;
+}
+
+sub get_method_list {
+    my $self = shift;
+    return grep { $self->has_method($_) } keys %{ $self->namespace };
+}
+
+1;
diff --git a/lib/Class/MOP/Package.pm b/lib/Class/MOP/Package.pm
index 586c90b..e30b1c9 100644
--- a/lib/Class/MOP/Package.pm
+++ b/lib/Class/MOP/Package.pm
@@ -6,13 +6,12 @@ use warnings;
 
 use Scalar::Util 'blessed', 'reftype';
 use Carp         'confess';
-use Sub::Name    'subname';
 
 our $VERSION   = '0.95';
 $VERSION = eval $VERSION;
 our $AUTHORITY = 'cpan:STEVAN';
 
-use base 'Class::MOP::Object';
+use base 'Class::MOP::HasMethods';
 
 # creation ...
 
@@ -102,15 +101,6 @@ sub namespace {
     \%{$_[0]->{'package'} . '::'} 
 }
 
-sub method_metaclass         { $_[0]->{'method_metaclass'}            }
-sub wrapped_method_metaclass { $_[0]->{'wrapped_method_metaclass'}    }
-
-# This doesn't always get initialized in a constructor because there is a
-# weird object construction path for subclasses of Class::MOP::Class. At one
-# point, this always got initialized by calling into the XS code first, but
-# that is no longer guaranteed to happen.
-sub _method_map { $_[0]->{'methods'} ||= {} }
-
 # utility methods
 
 {
@@ -295,136 +285,6 @@ sub list_all_package_symbols {
     }
 }
 
-## Methods
-
-sub wrap_method_body {
-    my ( $self, %args ) = @_;
-
-    ('CODE' eq ref $args{body})
-        || confess "Your code block must be a CODE reference";
-
-    $self->method_metaclass->wrap(
-        package_name => $self->name,
-        %args,
-    );
-}
-
-sub add_method {
-    my ($self, $method_name, $method) = @_;
-    (defined $method_name && length $method_name)
-        || confess "You must define a method name";
-
-    my $body;
-    if (blessed($method)) {
-        $body = $method->body;
-        if ($method->package_name ne $self->name) {
-            $method = $method->clone(
-                package_name => $self->name,
-                name         => $method_name,
-            ) if $method->can('clone');
-        }
-
-        $method->attach_to_class($self);
-    }
-    else {
-        # If a raw code reference is supplied, its method object is not created.
-        # The method object won't be created until required.
-        $body = $method;
-    }
-
-    $self->_method_map->{$method_name} = $method;
-
-    my ( $current_package, $current_name ) = Class::MOP::get_code_info($body);
-
-    if ( !defined $current_name || $current_name =~ /^__ANON__/ ) {
-        my $full_method_name = ($self->name . '::' . $method_name);
-        subname($full_method_name => $body);
-    }
-
-    $self->add_package_symbol(
-        { sigil => '&', type => 'CODE', name => $method_name },
-        $body,
-    );
-}
-
-sub _code_is_mine {
-    my ( $self, $code ) = @_;
-
-    my ( $code_package, $code_name ) = Class::MOP::get_code_info($code);
-
-    return $code_package && $code_package eq $self->name
-        || ( $code_package eq 'constant' && $code_name eq '__ANON__' );
-}
-
-sub has_method {
-    my ($self, $method_name) = @_;
-
-    (defined $method_name && length $method_name)
-        || confess "You must define a method name";
-
-    return defined($self->get_method($method_name));
-}
-
-sub get_method {
-    my ( $self, $method_name ) = @_;
-
-    (defined $method_name && length $method_name)
-        || confess "You must define a method name";
-
-    my $method_map = $self->_method_map;
-    my $map_entry  = $method_map->{$method_name};
-    my $code = $self->get_package_symbol(
-        {
-            name  => $method_name,
-            sigil => '&',
-            type  => 'CODE',
-        }
-    );
-
-    # This seems to happen in some weird cases where methods modifiers are
-    # added via roles or some other such bizareness. Honestly, I don't totally
-    # understand this, but returning the entry works, and keeps various MX
-    # modules from blowing up. - DR
-    return $map_entry if blessed $map_entry && !$code;
-
-    return $map_entry if blessed $map_entry && $map_entry->body == $code;
-
-    unless ($map_entry) {
-        return unless $code && $self->_code_is_mine($code);
-    }
-
-    $code ||= $map_entry;
-
-    return $method_map->{$method_name} = $self->wrap_method_body(
-        body                 => $code,
-        name                 => $method_name,
-        associated_metaclass => $self,
-    );
-}
-
-sub remove_method {
-    my ($self, $method_name) = @_;
-    (defined $method_name && length $method_name)
-        || confess "You must define a method name";
-
-    my $removed_method = delete $self->_full_method_map->{$method_name};
-    
-    $self->remove_package_symbol(
-        { sigil => '&', type => 'CODE', name => $method_name }
-    );
-
-    $removed_method->detach_from_class if $removed_method && blessed $removed_method;
-
-    $self->update_package_cache_flag; # still valid, since we just removed the method from the map
-
-    return $removed_method;
-}
-
-sub get_method_list {
-    my $self = shift;
-    return grep { $self->has_method($_) } keys %{ $self->namespace };
-}
-
 1;
 
 __END__
diff --git a/t/000_load.t b/t/000_load.t
index 3aa0fcd..4abe47a 100644
--- a/t/000_load.t
+++ b/t/000_load.t
@@ -5,11 +5,12 @@ use Test::More;
 
 BEGIN {
     use_ok('Class::MOP');
+    use_ok('Class::MOP::HasMethods');
     use_ok('Class::MOP::Package');
     use_ok('Class::MOP::Module');
     use_ok('Class::MOP::Class');
     use_ok('Class::MOP::Class::Immutable::Trait');
-    use_ok('Class::MOP::Attribute');
+    use_ok('Class::MOP::Method');
     use_ok('Class::MOP::Method');
     use_ok('Class::MOP::Method::Wrapped');
     use_ok('Class::MOP::Method::Inlined');
@@ -29,6 +30,7 @@ my %METAS = (
     'Class::MOP::Method::Accessor'  => Class::MOP::Method::Accessor->meta,
     'Class::MOP::Method::Constructor' =>
         Class::MOP::Method::Constructor->meta,
+    'Class::MOP::HasMethods'      => Class::MOP::HasMethods->meta,
     'Class::MOP::Package'         => Class::MOP::Package->meta,
     'Class::MOP::Module'          => Class::MOP::Module->meta,
     'Class::MOP::Class'           => Class::MOP::Class->meta,
@@ -70,6 +72,7 @@ is_deeply(
         Class::MOP::Class->meta,
         Class::MOP::Class::Immutable::Class::MOP::Class->meta,
         Class::MOP::class_of('Class::MOP::Class::Immutable::Trait'),
+        Class::MOP::HasMethods->meta,
         Class::MOP::Instance->meta,
         Class::MOP::Method->meta,
         Class::MOP::Method::Accessor->meta,
@@ -92,6 +95,7 @@ is_deeply(
             Class::MOP::Class
             Class::MOP::Class::Immutable::Class::MOP::Class
             Class::MOP::Class::Immutable::Trait
+            Class::MOP::HasMethods
             Class::MOP::Instance
             Class::MOP::Method
             Class::MOP::Method::Accessor
diff --git a/t/010_self_introspection.t b/t/010_self_introspection.t
index 067a264..72b1fbd 100644
--- a/t/010_self_introspection.t
+++ b/t/010_self_introspection.t
@@ -34,13 +34,6 @@ my @class_mop_package_methods = qw(
     add_package_symbol get_package_symbol has_package_symbol remove_package_symbol
     list_all_package_symbols get_all_package_symbols remove_package_glob
 
-    method_metaclass wrapped_method_metaclass
-
-    _method_map
-    _code_is_mine
-    has_method get_method add_method remove_method wrap_method_body
-    get_method_list _full_method_map
-
     _deconstruct_variable_name
 
     get_method_map
@@ -166,9 +159,6 @@ foreach my $non_method_name (qw(
 my @class_mop_package_attributes = (
     'package',
     'namespace',
-    'method_metaclass',
-    'wrapped_method_metaclass',
-    '_methods',
 );
 
 my @class_mop_module_attributes = (
@@ -249,33 +239,34 @@ is(ref($class_mop_package_meta->get_attribute('package')->reader), 'HASH', '...
 ok($class_mop_package_meta->get_attribute('package')->has_init_arg, '... Class::MOP::Class package has a init_arg');
 is($class_mop_package_meta->get_attribute('package')->init_arg, 'package', '... Class::MOP::Class package\'s a init_arg is package');
 
-ok($class_mop_package_meta->get_attribute('method_metaclass')->has_reader, '... Class::MOP::Package method_metaclass has a reader');
-is_deeply($class_mop_package_meta->get_attribute('method_metaclass')->reader,
-   { 'method_metaclass' => \&Class::MOP::Package::method_metaclass },
+# ... package, but inherited from HasMethods
+ok($class_mop_package_meta->find_attribute_by_name('method_metaclass')->has_reader, '... Class::MOP::Package method_metaclass has a reader');
+is_deeply($class_mop_package_meta->find_attribute_by_name('method_metaclass')->reader,
+   { 'method_metaclass' => \&Class::MOP::HasMethods::method_metaclass },
    '... Class::MOP::Package method_metaclass\'s a reader is &method_metaclass');
 
-ok($class_mop_package_meta->get_attribute('method_metaclass')->has_init_arg, '... Class::MOP::Package method_metaclass has a init_arg');
-is($class_mop_package_meta->get_attribute('method_metaclass')->init_arg,
+ok($class_mop_package_meta->find_attribute_by_name('method_metaclass')->has_init_arg, '... Class::MOP::Package method_metaclass has a init_arg');
+is($class_mop_package_meta->find_attribute_by_name('method_metaclass')->init_arg,
   'method_metaclass',
   '... Class::MOP::Package method_metaclass\'s init_arg is method_metaclass');
 
-ok($class_mop_package_meta->get_attribute('method_metaclass')->has_default, '... Class::MOP::Package method_metaclass has a default');
-is($class_mop_package_meta->get_attribute('method_metaclass')->default,
+ok($class_mop_package_meta->find_attribute_by_name('method_metaclass')->has_default, '... Class::MOP::Package method_metaclass has a default');
+is($class_mop_package_meta->find_attribute_by_name('method_metaclass')->default,
    'Class::MOP::Method',
   '... Class::MOP::Package method_metaclass\'s a default is Class::MOP:::Method');
 
-ok($class_mop_package_meta->get_attribute('wrapped_method_metaclass')->has_reader, '... Class::MOP::Package wrapped_method_metaclass has a reader');
-is_deeply($class_mop_package_meta->get_attribute('wrapped_method_metaclass')->reader,
-   { 'wrapped_method_metaclass' => \&Class::MOP::Package::wrapped_method_metaclass },
+ok($class_mop_package_meta->find_attribute_by_name('wrapped_method_metaclass')->has_reader, '... Class::MOP::Package wrapped_method_metaclass has a reader');
+is_deeply($class_mop_package_meta->find_attribute_by_name('wrapped_method_metaclass')->reader,
+   { 'wrapped_method_metaclass' => \&Class::MOP::HasMethods::wrapped_method_metaclass },
    '... Class::MOP::Package wrapped_method_metaclass\'s a reader is &wrapped_method_metaclass');
 
-ok($class_mop_package_meta->get_attribute('wrapped_method_metaclass')->has_init_arg, '... Class::MOP::Package wrapped_method_metaclass has a init_arg');
-is($class_mop_package_meta->get_attribute('wrapped_method_metaclass')->init_arg,
+ok($class_mop_package_meta->find_attribute_by_name('wrapped_method_metaclass')->has_init_arg, '... Class::MOP::Package wrapped_method_metaclass has a init_arg');
+is($class_mop_package_meta->find_attribute_by_name('wrapped_method_metaclass')->init_arg,
   'wrapped_method_metaclass',
   '... Class::MOP::Package wrapped_method_metaclass\'s init_arg is wrapped_method_metaclass');
 
-ok($class_mop_package_meta->get_attribute('method_metaclass')->has_default, '... Class::MOP::Package method_metaclass has a default');
-is($class_mop_package_meta->get_attribute('method_metaclass')->default,
+ok($class_mop_package_meta->find_attribute_by_name('method_metaclass')->has_default, '... Class::MOP::Package method_metaclass has a default');
+is($class_mop_package_meta->find_attribute_by_name('method_metaclass')->default,
    'Class::MOP::Method',
   '... Class::MOP::Package method_metaclass\'s a default is Class::MOP:::Method');
 
@@ -333,6 +324,7 @@ is_deeply(
         Class::MOP::Class
         Class::MOP::Module
         Class::MOP::Package
+        Class::MOP::HasMethods
         Class::MOP::Object
     / ],
     '... Class::MOP::Class->class_precedence_list == [ Class::MOP::Class Class::MOP::Module Class::MOP::Package ]');
diff --git a/xs/HasMethods.xs b/xs/HasMethods.xs
new file mode 100644
index 0000000..36099e0
--- /dev/null
+++ b/xs/HasMethods.xs
@@ -0,0 +1,133 @@
+#include "mop.h"
+
+SV *mop_method_metaclass;
+SV *mop_associated_metaclass;
+SV *mop_wrap;
+
+static void
+mop_update_method_map(pTHX_ SV *const self, SV *const class_name, HV *const stash, HV *const map)
+{
+    const char *const class_name_pv = HvNAME(stash); /* must be HvNAME(stash), not SvPV_nolen_const(class_name) */
+    SV   *method_metaclass_name;
+    char *method_name;
+    I32   method_name_len;
+    SV   *coderef;
+    HV   *symbols;
+    dSP;
+
+    symbols = mop_get_all_package_symbols(stash, TYPE_FILTER_CODE);
+    sv_2mortal((SV*)symbols);
+    (void)hv_iterinit(symbols);
+    while ( (coderef = hv_iternextsv(symbols, &method_name, &method_name_len)) ) {
+        CV *cv = (CV *)SvRV(coderef);
+        char *cvpkg_name;
+        char *cv_name;
+        SV *method_slot;
+        SV *method_object;
+
+        if (!mop_get_code_info(coderef, &cvpkg_name, &cv_name)) {
+            continue;
+        }
+
+        /* this checks to see that the subroutine is actually from our package  */
+        if ( !(strEQ(cvpkg_name, "constant") && strEQ(cv_name, "__ANON__")) ) {
+            if ( strNE(cvpkg_name, class_name_pv) ) {
+                continue;
+            }
+        }
+
+        method_slot = *hv_fetch(map, method_name, method_name_len, TRUE);
+        if ( SvOK(method_slot) ) {
+            SV *body;
+
+            if ( sv_isobject(method_slot) ) {
+                body = mop_call0(aTHX_ method_slot, KEY_FOR(body)); /* $method_object->body() */
+            }
+            else {
+                body = method_slot;
+            }
+
+            if ( SvROK(body) && ((CV *) SvRV(body)) == cv ) {
+                continue;
+            }
+        }
+
+        method_metaclass_name = mop_call0(aTHX_ self, mop_method_metaclass); /* $self->method_metaclass() */
+
+        /*
+            $method_object = $method_metaclass->wrap(
+                $cv,
+                associated_metaclass => $self,
+                package_name         => $class_name,
+                name                 => $method_name
+            );
+        */
+        ENTER;
+        SAVETMPS;
+
+        PUSHMARK(SP);
+        EXTEND(SP, 8);
+        PUSHs(method_metaclass_name); /* invocant */
+        mPUSHs(newRV_inc((SV *)cv));
+        PUSHs(mop_associated_metaclass);
+        PUSHs(self);
+        PUSHs(KEY_FOR(package_name));
+        PUSHs(class_name);
+        PUSHs(KEY_FOR(name));
+        mPUSHs(newSVpv(method_name, method_name_len));
+        PUTBACK;
+
+        call_sv(mop_wrap, G_SCALAR | G_METHOD);
+        SPAGAIN;
+        method_object = POPs;
+        PUTBACK;
+        /* $map->{$method_name} = $method_object */
+        sv_setsv(method_slot, method_object);
+
+        FREETMPS;
+        LEAVE;
+    }
+}
+
+MODULE = Class::MOP::HasMethods   PACKAGE = Class::MOP::HasMethods
+
+PROTOTYPES: DISABLE
+
+void
+_full_method_map(self)
+    SV *self
+    PREINIT:
+        HV *const obj        = (HV *)SvRV(self);
+        SV *const class_name = HeVAL( hv_fetch_ent(obj, KEY_FOR(package), 0, HASH_FOR(package)) );
+        HV *const stash      = gv_stashsv(class_name, 0);
+        UV current;
+        SV *cache_flag;
+        SV *map_ref;
+    PPCODE:
+        if (!stash) {
+             mXPUSHs(newRV_noinc((SV *)newHV()));
+             return;
+        }
+
+        current    = mop_check_package_cache_flag(aTHX_ stash);
+        cache_flag = HeVAL( hv_fetch_ent(obj, KEY_FOR(package_cache_flag), TRUE, HASH_FOR(package_cache_flag)));
+        map_ref    = HeVAL( hv_fetch_ent(obj, KEY_FOR(methods), TRUE, HASH_FOR(methods)));
+
+        /* $self->{methods} does not yet exist (or got deleted) */
+        if ( !SvROK(map_ref) || SvTYPE(SvRV(map_ref)) != SVt_PVHV ) {
+            SV *new_map_ref = newRV_noinc((SV *)newHV());
+            sv_2mortal(new_map_ref);
+            sv_setsv(map_ref, new_map_ref);
+        }
+
+        if ( !SvOK(cache_flag) || SvUV(cache_flag) != current ) {
+            mop_update_method_map(aTHX_ self, class_name, stash, (HV *)SvRV(map_ref));
+            sv_setuv(cache_flag, mop_check_package_cache_flag(aTHX_ stash)); /* update_cache_flag() */
+        }
+
+        XPUSHs(map_ref);
+
+BOOT:
+    mop_method_metaclass     = newSVpvs("method_metaclass");
+    mop_associated_metaclass = newSVpvs("associated_metaclass");
+    mop_wrap                 = newSVpvs("wrap");
diff --git a/xs/MOP.xs b/xs/MOP.xs
index e1a5ac7..48c695f 100644
--- a/xs/MOP.xs
+++ b/xs/MOP.xs
@@ -1,9 +1,5 @@
 #include "mop.h"
 
-SV *mop_method_metaclass;
-SV *mop_associated_metaclass;
-SV *mop_wrap;
-
 static bool
 find_method (const char *key, STRLEN keylen, SV *val, void *ud)
 {
@@ -15,6 +11,7 @@ find_method (const char *key, STRLEN keylen, SV *val, void *ud)
     return FALSE;
 }
 
+EXTERN_C XS(boot_Class__MOP__HasMethods);
 EXTERN_C XS(boot_Class__MOP__Package);
 EXTERN_C XS(boot_Class__MOP__Attribute);
 EXTERN_C XS(boot_Class__MOP__Method);
@@ -26,10 +23,7 @@ PROTOTYPES: DISABLE
 BOOT:
     mop_prehash_keys();
 
-    mop_method_metaclass     = newSVpvs("method_metaclass");
-    mop_wrap                 = newSVpvs("wrap");
-    mop_associated_metaclass = newSVpvs("associated_metaclass");
-
+    MOP_CALL_BOOT (boot_Class__MOP__HasMethods);
     MOP_CALL_BOOT (boot_Class__MOP__Package);
     MOP_CALL_BOOT (boot_Class__MOP__Attribute);
     MOP_CALL_BOOT (boot_Class__MOP__Method);
diff --git a/xs/Package.xs b/xs/Package.xs
index 1172483..ce8d390 100644
--- a/xs/Package.xs
+++ b/xs/Package.xs
@@ -1,90 +1,5 @@
 #include "mop.h"
 
-static void
-mop_update_method_map(pTHX_ SV *const self, SV *const class_name, HV *const stash, HV *const map)
-{
-    const char *const class_name_pv = HvNAME(stash); /* must be HvNAME(stash), not SvPV_nolen_const(class_name) */
-    SV   *method_metaclass_name;
-    char *method_name;
-    I32   method_name_len;
-    SV   *coderef;
-    HV   *symbols;
-    dSP;
-
-    symbols = mop_get_all_package_symbols(stash, TYPE_FILTER_CODE);
-    sv_2mortal((SV*)symbols);
-    (void)hv_iterinit(symbols);
-    while ( (coderef = hv_iternextsv(symbols, &method_name, &method_name_len)) ) {
-        CV *cv = (CV *)SvRV(coderef);
-        char *cvpkg_name;
-        char *cv_name;
-        SV *method_slot;
-        SV *method_object;
-
-        if (!mop_get_code_info(coderef, &cvpkg_name, &cv_name)) {
-            continue;
-        }
-
-        /* this checks to see that the subroutine is actually from our package  */
-        if ( !(strEQ(cvpkg_name, "constant") && strEQ(cv_name, "__ANON__")) ) {
-            if ( strNE(cvpkg_name, class_name_pv) ) {
-                continue;
-            }
-        }
-
-        method_slot = *hv_fetch(map, method_name, method_name_len, TRUE);
-        if ( SvOK(method_slot) ) {
-            SV *body;
-
-            if ( sv_isobject(method_slot) ) {
-                body = mop_call0(aTHX_ method_slot, KEY_FOR(body)); /* $method_object->body() */
-            }
-            else {
-                body = method_slot;
-            }
-
-            if ( SvROK(body) && ((CV *) SvRV(body)) == cv ) {
-                continue;
-            }
-        }
-
-        method_metaclass_name = mop_call0(aTHX_ self, mop_method_metaclass); /* $self->method_metaclass() */
-
-        /*
-            $method_object = $method_metaclass->wrap(
-                $cv,
-                associated_metaclass => $self,
-                package_name         => $class_name,
-                name                 => $method_name
-            );
-        */
-        ENTER;
-        SAVETMPS;
-
-        PUSHMARK(SP);
-        EXTEND(SP, 8);
-        PUSHs(method_metaclass_name); /* invocant */
-        mPUSHs(newRV_inc((SV *)cv));
-        PUSHs(mop_associated_metaclass);
-        PUSHs(self);
-        PUSHs(KEY_FOR(package_name));
-        PUSHs(class_name);
-        PUSHs(KEY_FOR(name));
-        mPUSHs(newSVpv(method_name, method_name_len));
-        PUTBACK;
-
-        call_sv(mop_wrap, G_SCALAR | G_METHOD);
-        SPAGAIN;
-        method_object = POPs;
-        PUTBACK;
-        /* $map->{$method_name} = $method_object */
-        sv_setsv(method_slot, method_object);
-
-        FREETMPS;
-        LEAVE;
-    }
-}
-
 MODULE = Class::MOP::Package   PACKAGE = Class::MOP::Package
 
 PROTOTYPES: DISABLE
@@ -120,39 +35,5 @@ get_all_package_symbols(self, filter=TYPE_FILTER_NONE)
         symbols = mop_get_all_package_symbols(stash, filter);
         PUSHs(sv_2mortal(newRV_noinc((SV *)symbols)));
 
-void
-_full_method_map(self)
-    SV *self
-    PREINIT:
-        HV *const obj        = (HV *)SvRV(self);
-        SV *const class_name = HeVAL( hv_fetch_ent(obj, KEY_FOR(package), 0, HASH_FOR(package)) );
-        HV *const stash      = gv_stashsv(class_name, 0);
-        UV current;
-        SV *cache_flag;
-        SV *map_ref;
-    PPCODE:
-        if (!stash) {
-             mXPUSHs(newRV_noinc((SV *)newHV()));
-             return;
-        }
-
-        current    = mop_check_package_cache_flag(aTHX_ stash);
-        cache_flag = HeVAL( hv_fetch_ent(obj, KEY_FOR(package_cache_flag), TRUE, HASH_FOR(package_cache_flag)));
-        map_ref    = HeVAL( hv_fetch_ent(obj, KEY_FOR(methods), TRUE, HASH_FOR(methods)));
-
-        /* $self->{methods} does not yet exist (or got deleted) */
-        if ( !SvROK(map_ref) || SvTYPE(SvRV(map_ref)) != SVt_PVHV ) {
-            SV *new_map_ref = newRV_noinc((SV *)newHV());
-            sv_2mortal(new_map_ref);
-            sv_setsv(map_ref, new_map_ref);
-        }
-
-        if ( !SvOK(cache_flag) || SvUV(cache_flag) != current ) {
-            mop_update_method_map(aTHX_ self, class_name, stash, (HV *)SvRV(map_ref));
-            sv_setuv(cache_flag, mop_check_package_cache_flag(aTHX_ stash)); /* update_cache_flag() */
-        }
-
-        XPUSHs(map_ref);
-
 BOOT:
     INSTALL_SIMPLE_READER_WITH_KEY(Package, name, package);