Remove Sub::Name as a requirement form the code (not from tests yet)

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index db6e3a7..9cb52e9 100644 (file)
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -33,6 +33,17 @@ BEGIN {
     }
 }
 
+# sub subname { $_[1] }
+
+BEGIN {
+    local $@;
+    if ( eval { require Sub::Name } ) {
+        *subname = \&Sub::Name::subname;
+    } else {
+        *subname = sub { $_[1] };
+    }
+}
+
 {
     # Metaclasses are singletons, so we cache them here.
     # there is no need to worry about destruction though
@@ -782,6 +793,10 @@ In Perl 5.10 or greater, this flag is package specific. However in
 versions prior to 5.10, this will use the C<PL_sub_generation> variable
 which is not package specific. 
 
+=item B<subname ($name, $code)>
+
+If L<Sub::Name> is available uses that, if not it just returns C<$code>.
+
 =item B<get_code_info ($code)>
 
 This function returns two values, the name of the package the C<$code> 

diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm
index c3d760b..b717b36 100644 (file)
--- a/lib/Class/MOP/Attribute.pm
+++ b/lib/Class/MOP/Attribute.pm
@@ -304,7 +304,7 @@ sub process_accessors {
         (reftype($accessor) eq 'HASH')
             || confess "bad accessor/reader/writer/predicate/clearer format, must be a HASH ref";
         my ($name, $method) = %{$accessor};
-        $method = $self->accessor_metaclass->wrap($method);
+        $method = $self->accessor_metaclass->wrap($method, name => $name, package_name => $self->associated_class->name );
         $self->associate_method($method);
         return ($name, $method);
     }
@@ -316,6 +316,8 @@ sub process_accessors {
                 attribute     => $self,
                 is_inline     => $inline_me,
                 accessor_type => $type,
+                package_name  => $self->associated_class->name,
+                name          => $accessor,
             );
         };
         confess "Could not create the '$type' method for " . $self->name . " because : $@" if $@;

diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index fb65c44..91f6be0 100644 (file)
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -10,7 +10,6 @@ use Class::MOP::Method::Wrapped;
 
 use Carp         'confess';
 use Scalar::Util 'blessed', 'reftype', 'weaken', 'refaddr';
-use Sub::Name    'subname';
 
 our $VERSION   = '0.31';
 our $AUTHORITY = 'cpan:STEVAN';
@@ -315,26 +314,30 @@ sub get_method_map {
     my $class_name       = $self->name;
     my $method_metaclass = $self->method_metaclass;
 
-    %$map = map {
-        my $symbol = $_;
+    my %map;
 
+    foreach my $symbol ( $self->list_all_package_symbols('CODE') ) {
         my $code = $self->get_package_symbol('&' . $symbol);
 
         my $method = $map->{$symbol};
 
         my ($pkg, $name) = Class::MOP::get_code_info($code);
-      
-        if ( !$method and ($pkg  || '') ne $class_name && ($name || '') ne '__ANON__' ) {
-            ();
-        } else {
-            if ( !$method or refaddr($method->body) != refaddr($code) ) {
-                $method = $method_metaclass->wrap($code);
-            }
 
-            $symbol => $method;
+        no warnings 'uninitialized';
+
+        next if ($pkg  || '') ne $class_name &&
+                ($name || '') ne '__ANON__';
+
+        if ( !$method or refaddr($method->body) != refaddr($code) ) {
+            #warn "Regenerating $method" if $method;
+            # FIXME preserve name if $method, doesn't seem like it ever happens
+            $method = $method_metaclass->wrap($code);
         }
-    } $self->list_all_package_symbols('CODE');
 
+        $map{$symbol} = $method;
+    };
+
+    %$map = %map;
 
     return $map;
 }
@@ -558,22 +561,23 @@ sub class_precedence_list {
 sub add_method {
     my ($self, $method_name, $method) = @_;
     (defined $method_name && $method_name)
-        || confess "You must define a method name";
+        || confess "You must define a method name"; # FIXME default to $method->name ?
 
     my $body;
     if (blessed($method)) {
         $body = $method->body;
+        # FIXME clone method and change package_name/name
     }
     else {
         $body = $method;
         ('CODE' eq (reftype($body) || ''))
             || confess "Your code block must be a CODE reference";
-        $method = $self->method_metaclass->wrap($body);
+        $method = $self->method_metaclass->wrap($body, package_name => $self->name, name => $method_name);
     }
     $self->get_method_map->{$method_name} = $method;
 
     my $full_method_name = ($self->name . '::' . $method_name);
-    $self->add_package_symbol("&${method_name}" => subname $full_method_name => $body);
+    $self->add_package_symbol("&${method_name}" => Class::MOP::subname($full_method_name => $body) );
     $self->update_package_cache_flag;    
 }
 
@@ -608,7 +612,7 @@ sub add_method {
         (defined $method_name && $method_name)
             || confess "You must pass in a method name";
         my $method = $fetch_and_prepare_method->($self, $method_name);
-        $method->add_before_modifier(subname ':before' => $method_modifier);
+        $method->add_before_modifier(Class::MOP::subname(':before' => $method_modifier));
     }
 
     sub add_after_method_modifier {
@@ -616,7 +620,7 @@ sub add_method {
         (defined $method_name && $method_name)
             || confess "You must pass in a method name";
         my $method = $fetch_and_prepare_method->($self, $method_name);
-        $method->add_after_modifier(subname ':after' => $method_modifier);
+        $method->add_after_modifier(Class::MOP::subname(':after' => $method_modifier));
     }
 
     sub add_around_method_modifier {
@@ -624,7 +628,7 @@ sub add_method {
         (defined $method_name && $method_name)
             || confess "You must pass in a method name";
         my $method = $fetch_and_prepare_method->($self, $method_name);
-        $method->add_around_modifier(subname ':around' => $method_modifier);
+        $method->add_around_modifier(Class::MOP::subname(':around' => $method_modifier));
     }
 
     # NOTE:

diff --git a/lib/Class/MOP/Immutable.pm b/lib/Class/MOP/Immutable.pm
index 284949a..c8e453c 100644 (file)
--- a/lib/Class/MOP/Immutable.pm
+++ b/lib/Class/MOP/Immutable.pm
@@ -8,7 +8,6 @@ use Class::MOP::Method::Constructor;
 
 use Carp         'confess';
 use Scalar::Util 'blessed';
-use Sub::Name    'subname';
 
 our $VERSION   = '0.06';
 our $AUTHORITY = 'cpan:STEVAN';

diff --git a/lib/Class/MOP/Method.pm b/lib/Class/MOP/Method.pm
index b726e7c..d241582 100644 (file)
--- a/lib/Class/MOP/Method.pm
+++ b/lib/Class/MOP/Method.pm
@@ -20,12 +20,14 @@ use overload '&{}' => sub { $_[0]->body }, fallback => 1;
 # construction
 
 sub wrap { 
-    my $class = shift;
-    my $code  = shift;
+    my ( $class, $code, %params ) = @_;
+
     ('CODE' eq (reftype($code) || ''))
         || confess "You must supply a CODE reference to bless, not (" . ($code || 'undef') . ")";
     bless { 
-        '&!body' => $code 
+        '&!body' => $code,
+        '$!package_name' => $params{package_name} || (Class::MOP::get_code_info($code))[0],
+        '$!name' => $params{name} || (Class::MOP::get_code_info($code))[1],
     } => blessed($class) || $class;
 }
 
@@ -40,11 +42,11 @@ sub body { (shift)->{'&!body'} }
 # NOTE: 
 # this may not be the same name 
 # as the class you got it from
-# This gets the package stash name 
+# This is the package stash name 
 # associated with the actual CODE-ref
-sub package_name { 
-       my $code = (shift)->body;
-       (Class::MOP::get_code_info($code))[0];
+# meaning the package it was defined in
+sub package_name {
+    (shift)->{'$!package_name'};
 }
 
 # NOTE: 
@@ -53,8 +55,7 @@ sub package_name {
 # with. This gets the name associated
 # with the actual CODE-ref
 sub name { 
-       my $code = (shift)->body;
-       (Class::MOP::get_code_info($code))[1];
+    (shift)->{'$!name'};
 }
 
 sub fully_qualified_name {

diff --git a/lib/Class/MOP/Method/Accessor.pm b/lib/Class/MOP/Method/Accessor.pm
index 62eaab8..e0acd43 100644 (file)
--- a/lib/Class/MOP/Method/Accessor.pm
+++ b/lib/Class/MOP/Method/Accessor.pm
@@ -32,6 +32,8 @@ sub new {
         '$!attribute'     => $options{attribute},
         '$!is_inline'     => ($options{is_inline} || 0),
         '$!accessor_type' => $options{accessor_type},
+        '$!package_name'  => $options{package_name},
+        '$!name'          => $options{name},
     } => $class;
 
     # we don't want this creating

diff --git a/lib/Class/MOP/Method/Wrapped.pm b/lib/Class/MOP/Method/Wrapped.pm
index c32b506..48626cd 100644 (file)
--- a/lib/Class/MOP/Method/Wrapped.pm
+++ b/lib/Class/MOP/Method/Wrapped.pm
@@ -6,7 +6,6 @@ use warnings;
 
 use Carp         'confess';
 use Scalar::Util 'reftype', 'blessed';
-use Sub::Name    'subname';
 
 our $VERSION   = '0.02';
 our $AUTHORITY = 'cpan:STEVAN';

diff --git a/t/003_methods.t b/t/003_methods.t
index 9dfcb9e..b836875 100644 (file)
--- a/t/003_methods.t
+++ b/t/003_methods.t
@@ -8,6 +8,8 @@ use Test::Exception;
 
 use Scalar::Util qw/reftype/;
 
+use Sub::Name ();
+
 BEGIN {
     use_ok('Class::MOP');   
     use_ok('Class::MOP::Class');        
@@ -50,8 +52,8 @@ BEGIN {
     {
         no strict 'refs';
         *{'Foo::bling'} = sub { '$$Bling$$' };
-        *{'Foo::bang'} = Sub::Name::subname 'Foo::bang' => sub { '!BANG!' }; 
-        *{'Foo::boom'} = Sub::Name::subname 'boom' => sub { '!BOOM!' };     
+        *{'Foo::bang'} = Sub::Name::subname('Foo::bang' => sub { '!BANG!' });
+        *{'Foo::boom'} = Sub::Name::subname('boom' => sub { '!BOOM!' });
         
         eval "package Foo; sub evaled_foo { 'Foo::evaled_foo' }";           
     }