wrap_method_body

diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 0eb6eb2..07a4d41 100644 (file)
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -587,6 +587,20 @@ sub class_precedence_list {
 
 ## Methods
 
+sub wrap_method_body {
+    my ( $self, %args ) = @_;
+
+    my $body = delete $args{body}; # delete is for compat
+
+    ('CODE' eq ref($body))
+        || confess "Your code block must be a CODE reference";
+
+    $self->method_metaclass->wrap( $body => (
+        package_name => $self->name,
+        %args,
+    ));
+}
+
 sub add_method {
     my ($self, $method_name, $method) = @_;
     (defined $method_name && $method_name)
@@ -608,14 +622,7 @@ sub add_method {
     }
     else {
         $body = $method;
-        ('CODE' eq ref($body))
-            || confess "Your code block must be a CODE reference";
-        $method = $self->method_metaclass->wrap(
-            $body => (
-                package_name => $self->name,
-                name         => $method_name
-            )
-        );
+        $method = $self->wrap_method_body( body => $body, name => $method_name );
     }
 
     $method->attach_to_class($self);
@@ -1442,7 +1449,11 @@ Returns a HASH ref of name to CODE reference mapping for this class.
 Returns the class name of the method metaclass, see L<Class::MOP::Method> 
 for more information on the method metaclasses.
 
-=item B<add_method ($method_name, $method)>
+=item B<wrap_method_body(%attrs)>
+
+Wrap a code ref (C<$attrs{body>) with C<method_metaclass>.
+
+=item B<add_method ($method_name, $method, %attrs)>
 
 This will take a C<$method_name> and CODE reference to that
 C<$method> and install it into the class's package.

diff --git a/t/010_self_introspection.t b/t/010_self_introspection.t
index 3b84c34..00006be 100644 (file)
--- a/t/010_self_introspection.t
+++ b/t/010_self_introspection.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 232;
+use Test::More tests => 234;
 use Test::Exception;
 
 BEGIN {
@@ -73,7 +73,7 @@ my @class_mop_class_methods = qw(
 
     superclasses subclasses class_precedence_list linearized_isa
 
-    has_method get_method add_method remove_method alias_method
+    has_method get_method add_method remove_method alias_method wrap_method_body
     get_method_list get_method_map get_all_methods compute_all_applicable_methods
         find_method_by_name find_all_methods_by_name find_next_method_by_name