From: Florian Ragwitz <rafl@debian.org>
Date: Sat, 14 Feb 2009 00:44:55 +0000 (+0000)
Subject: Add a wrapped_method_metaclass attribute to CMOP::Class.
X-Git-Tag: 0.77~6
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=77373da8278af3084a9877dff00890f60adffdc7;p=gitmo%2FClass-MOP.git

Add a wrapped_method_metaclass attribute to CMOP::Class.

Stop hardcoding Class::MOP::Method::Wrapped.
---

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index 4842056..668c1e2 100644
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -388,6 +388,18 @@ Class::MOP::Class->meta->add_attribute(
 );
 
 Class::MOP::Class->meta->add_attribute(
+    Class::MOP::Attribute->new('wrapped_method_metaclass' => (
+        reader   => {
+            # NOTE:
+            # we just alias the original method
+            # rather than re-produce it here
+            'wrapped_method_metaclass' => \&Class::MOP::Class::wrapped_method_metaclass
+        },
+        default  => 'Class::MOP::Method::Wrapped',
+    ))
+);
+
+Class::MOP::Class->meta->add_attribute(
     Class::MOP::Attribute->new('instance_metaclass' => (
         reader   => {
             # NOTE: we need to do this in order
diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index bdf895d..41e751e 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -103,7 +103,7 @@ sub _new {
 
     bless {
         # inherited from Class::MOP::Package
-        'package'             => $options->{package},
+        'package'                     => $options->{package},
 
         # NOTE:
         # since the following attributes will
@@ -113,18 +113,19 @@ sub _new {
         # listed here for reference, because they
         # should not actually have a value associated
         # with the slot.
-        'namespace'           => \undef,
+        'namespace'                   => \undef,
         # inherited from Class::MOP::Module
-        'version'             => \undef,
-        'authority'           => \undef,
+        'version'                     => \undef,
+        'authority'                   => \undef,
         # defined in Class::MOP::Class
-        'superclasses'        => \undef,
-
-        'methods'             => {},
-        'attributes'          => {},
-        'attribute_metaclass' => $options->{'attribute_metaclass'} || 'Class::MOP::Attribute',
-        'method_metaclass'    => $options->{'method_metaclass'}    || 'Class::MOP::Method',
-        'instance_metaclass'  => $options->{'instance_metaclass'}  || 'Class::MOP::Instance',
+        'superclasses'                => \undef,
+
+        'methods'                     => {},
+        'attributes'                  => {},
+        'attribute_metaclass'         => $options->{'attribute_metaclass'}      || 'Class::MOP::Attribute',
+        'method_metaclass'            => $options->{'method_metaclass'}         || 'Class::MOP::Method',
+        'wrapped_method_metaclass'    => $options->{'wrapped_method_metaclass'} || 'Class::MOP::Method::Wrapped',
+        'instance_metaclass'          => $options->{'instance_metaclass'}       || 'Class::MOP::Instance',
     }, $class;
 }
 
@@ -306,10 +307,11 @@ sub create {
 # all these attribute readers will be bootstrapped
 # away in the Class::MOP bootstrap section
 
-sub get_attribute_map   { $_[0]->{'attributes'}          }
-sub attribute_metaclass { $_[0]->{'attribute_metaclass'} }
-sub method_metaclass    { $_[0]->{'method_metaclass'}    }
-sub instance_metaclass  { $_[0]->{'instance_metaclass'}  }
+sub get_attribute_map        { $_[0]->{'attributes'}                  }
+sub attribute_metaclass      { $_[0]->{'attribute_metaclass'}         }
+sub method_metaclass         { $_[0]->{'method_metaclass'}            }
+sub wrapped_method_metaclass { $_[0]->{'wrapped_method_metaclass'}    }
+sub instance_metaclass       { $_[0]->{'instance_metaclass'}          }
 
 sub get_method_map {
     my $self = shift;
@@ -658,6 +660,7 @@ sub add_method {
 {
     my $fetch_and_prepare_method = sub {
         my ($self, $method_name) = @_;
+        my $wrapped_metaclass = $self->wrapped_method_metaclass;
         # fetch it locally
         my $method = $self->get_method($method_name);
         # if we dont have local ...
@@ -670,12 +673,12 @@ sub add_method {
             # and now make sure to wrap it
             # even if it is already wrapped
             # because we need a new sub ref
-            $method = Class::MOP::Method::Wrapped->wrap($method);
+            $method = $wrapped_metaclass->wrap($method);
         }
         else {
             # now make sure we wrap it properly
-            $method = Class::MOP::Method::Wrapped->wrap($method)
-                unless $method->isa('Class::MOP::Method::Wrapped');
+            $method = $wrapped_metaclass->wrap($method)
+                unless $method->isa($wrapped_metaclass);
         }
         $self->add_method($method_name => $method);
         return $method;
diff --git a/t/010_self_introspection.t b/t/010_self_introspection.t
index fecd632..5751cbe 100644
--- a/t/010_self_introspection.t
+++ b/t/010_self_introspection.t
@@ -1,7 +1,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 236;
+use Test::More tests => 246;
 use Test::Exception;
 
 use Class::MOP;
@@ -66,7 +66,7 @@ my @class_mop_class_methods = qw(
     add_dependent_meta_instance remove_dependent_meta_instance
     invalidate_meta_instances invalidate_meta_instance
 
-    attribute_metaclass method_metaclass
+    attribute_metaclass method_metaclass wrapped_method_metaclass
 
     superclasses subclasses class_precedence_list linearized_isa
 
@@ -157,6 +157,7 @@ my @class_mop_class_attributes = (
     'attributes',
     'attribute_metaclass',
     'method_metaclass',
+    'wrapped_method_metaclass',
     'instance_metaclass'
 );
 
@@ -269,6 +270,21 @@ is($class_mop_class_meta->get_attribute('method_metaclass')->default,
    'Class::MOP::Method',
   '... Class::MOP::Class method_metaclass\'s a default is Class::MOP:::Method');
 
+ok($class_mop_class_meta->get_attribute('wrapped_method_metaclass')->has_reader, '... Class::MOP::Class wrapped_method_metaclass has a reader');
+is_deeply($class_mop_class_meta->get_attribute('wrapped_method_metaclass')->reader,
+   { 'wrapped_method_metaclass' => \&Class::MOP::Class::wrapped_method_metaclass },
+   '... Class::MOP::Class wrapped_method_metaclass\'s a reader is &wrapped_method_metaclass');
+
+ok($class_mop_class_meta->get_attribute('wrapped_method_metaclass')->has_init_arg, '... Class::MOP::Class wrapped_method_metaclass has a init_arg');
+is($class_mop_class_meta->get_attribute('wrapped_method_metaclass')->init_arg,
+  'wrapped_method_metaclass',
+  '... Class::MOP::Class wrapped_method_metaclass\'s init_arg is wrapped_method_metaclass');
+
+ok($class_mop_class_meta->get_attribute('method_metaclass')->has_default, '... Class::MOP::Class method_metaclass has a default');
+is($class_mop_class_meta->get_attribute('method_metaclass')->default,
+   'Class::MOP::Method',
+  '... Class::MOP::Class method_metaclass\'s a default is Class::MOP:::Method');
+
 # check the values of some of the methods
 
 is($class_mop_class_meta->name, 'Class::MOP::Class', '... Class::MOP::Class->name');