From: Dann <techmemo@gmail.com>
Date: Tue, 13 Jan 2009 17:40:23 +0000 (+0000)
Subject: use Data::Util to make modifier fast if Data::Util is installed
X-Git-Tag: 0.19~71
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4859d490c20857ad700946803544f1d9e83a56bd;p=gitmo%2FMouse.git

use Data::Util to make modifier fast if Data::Util is installed
---

diff --git a/Changes b/Changes
index 6c60a59..2d38307 100644
--- 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
diff --git a/lib/Mouse/Meta/Class.pm b/lib/Mouse/Meta/Class.pm
index 8668990..f09cdaa 100644
--- a/lib/Mouse/Meta/Class.pm
+++ b/lib/Mouse/Meta/Class.pm
@@ -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} }