use Data::Util to make modifier fast if Data::Util is installed
Dann [Tue, 13 Jan 2009 17:40:23 +0000 (17:40 +0000)]
Changes
lib/Mouse/Meta/Class.pm

diff --git a/Changes b/Changes
index 6c60a59..2d38307 100644 (file)
--- a/Changes
+++ b/Changes
@@ -11,7 +11,10 @@ Revision history for Mouse
 
     * class_type shouldn't load the class (Moose compat; no easy fix :/)
 
-    * suppress warninsgs when we use around and has '+...' 
+    * suppress warninsgs when we use around and has '+...' (dann) 
+
+    * use Data::Util to make modifier fast if Data::Util is installed (dann)
+
 
 0.14 Sat Dec 20 16:53:05 2008
     * POD fix
index 8668990..f09cdaa 100644 (file)
@@ -160,37 +160,68 @@ sub is_immutable { $_[0]->{is_immutable} }
 
 sub attribute_metaclass { "Mouse::Meta::Class" }
 
+sub _install_fast_modifier {
+    my $self     = shift;
+    my $into     = shift;
+    my $type     = shift;
+    my $modifier = pop;
+
+    foreach my $name (@_) {
+        my $method = Data::Util::get_code_ref( $into, $name );
+
+        if ( !$method || !Data::Util::subroutine_modifier($method) ) {
+
+            unless ($method) {
+                $method = $into->can($name)
+                    or confess "The method '$name' is not found in the inheritance hierarchy for class $into";
+            }
+            $method = Data::Util::modify_subroutine( $method,
+                $type => [$modifier] );
+
+            no warnings 'redefine';
+            Data::Util::install_subroutine( $into, $name => $method );
+        }
+        else {
+            Data::Util::subroutine_modifier( $method, $type => $modifier );
+        }
+    }
+    return;
+}
+
+sub _install_modifier {
+    my ( $self, $into, $type, $name, $code ) = @_;
+    if (eval "require Data::Util; 1") {
+        $self->_install_fast_modifier( 
+            $into,
+            $type,
+            $name,
+            $code
+        );
+    }
+    else {
+        require Class::Method::Modifiers;
+        Class::Method::Modifiers::_install_modifier( 
+            $into,
+            $type,
+            $name,
+            $code
+        );
+    }
+}
+
 sub add_before_method_modifier {
-    my ($self, $name, $code) = @_;
-    require Class::Method::Modifiers;
-    Class::Method::Modifiers::_install_modifier(
-        $self->name,
-        'before',
-        $name,
-        $code,
-    );
+    my ( $self, $name, $code ) = @_;
+    $self->_install_modifier( $self->name, 'before', $name, $code );
 }
 
 sub add_around_method_modifier {
-    my ($self, $name, $code) = @_;
-    require Class::Method::Modifiers;
-    Class::Method::Modifiers::_install_modifier(
-        $self->name,
-        'around',
-        $name,
-        $code,
-    );
+    my ( $self, $name, $code ) = @_;
+    $self->_install_modifier( $self->name, 'around', $name, $code );
 }
 
 sub add_after_method_modifier {
-    my ($self, $name, $code) = @_;
-    require Class::Method::Modifiers;
-    Class::Method::Modifiers::_install_modifier(
-        $self->name,
-        'after',
-        $name,
-        $code,
-    );
+    my ( $self, $name, $code ) = @_;
+    $self->_install_modifier( $self->name, 'after', $name, $code );
 }
 
 sub roles { $_[0]->{roles} }