Version 1.12

[gitmo/Class-MOP.git] / lib / Class / MOP / Mixin / HasMethods.pm

diff --git a/lib/Class/MOP/Mixin/HasMethods.pm b/lib/Class/MOP/Mixin/HasMethods.pm
index 032fb8d..8d9a807 100644 (file)
--- a/lib/Class/MOP/Mixin/HasMethods.pm
+++ b/lib/Class/MOP/Mixin/HasMethods.pm
@@ -3,7 +3,9 @@ package Class::MOP::Mixin::HasMethods;
 use strict;
 use warnings;
 
-our $VERSION   = '1.04';
+use Class::MOP::Method::Meta;
+
+our $VERSION   = '1.12';
 $VERSION = eval $VERSION;
 our $AUTHORITY = 'cpan:STEVAN';
 
@@ -15,6 +17,24 @@ use base 'Class::MOP::Mixin';
 
 sub method_metaclass         { $_[0]->{'method_metaclass'}            }
 sub wrapped_method_metaclass { $_[0]->{'wrapped_method_metaclass'}    }
+sub _meta_method_class       { 'Class::MOP::Method::Meta'             }
+
+sub _add_meta_method {
+    my $self = shift;
+    my ($name) = @_;
+    my $existing_method = $self->can('find_method_by_name')
+                              ? $self->find_method_by_name($name)
+                              : $self->get_method($name);
+    return if $existing_method
+           && $existing_method->isa($self->_meta_method_class);
+    $self->add_method(
+        $name => $self->_meta_method_class->wrap(
+            name                 => $name,
+            package_name         => $self->name,
+            associated_metaclass => $self,
+        )
+    );
+}
 
 # 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
@@ -161,11 +181,12 @@ sub get_method_list {
 
     my $namespace = $self->namespace;
 
-    # Constants will show up as some sort of reference in the namespace hash
-    # ref.
+    # Constants may show up as some sort of non-GLOB reference in the
+    # namespace hash ref, depending on the Perl version.
     return grep {
-               ! ref $namespace->{$_}
-            && *{ $namespace->{$_} }{CODE}
+        defined $namespace->{$_}
+            && ( ref( \$namespace->{$_} ) ne 'GLOB'
+            || *{ $namespace->{$_} }{CODE} )
             && $self->has_method($_)
         }
         keys %{$namespace};
@@ -180,10 +201,24 @@ sub _get_local_methods {
     my $namespace = $self->namespace;
 
     return map { $self->get_method($_) }
-        grep { ! ref $namespace->{$_} && *{ $namespace->{$_} }{CODE} }
+        grep {
+        defined $namespace->{$_}
+            && ( ref $namespace->{$_}
+            || *{ $namespace->{$_} }{CODE} )
+        }
         keys %{$namespace};
 }
 
+sub _restore_metamethods_from {
+    my $self = shift;
+    my ($old_meta) = @_;
+
+    for my $method ($old_meta->_get_local_methods) {
+        $method->_make_compatible_with($self->method_metaclass);
+        $self->add_method($method->name => $method);
+    }
+}
+
 1;
 
 __END__