[Moose-commits] r7299 - in Mouse/trunk: . lib/Mouse/Meta

[dann at code2.0beta.co.uk]

Author: dann
Date: 2009-01-13 09:40:23 -0800 (Tue, 13 Jan 2009)
New Revision: 7299

Modified:
   Mouse/trunk/Changes
   Mouse/trunk/lib/Mouse/Meta/Class.pm
Log:
use Data::Util to make modifier fast if Data::Util is installed



Modified: Mouse/trunk/Changes
===================================================================
--- Mouse/trunk/Changes	2009-01-12 21:47:55 UTC (rev 7298)
+++ Mouse/trunk/Changes	2009-01-13 17:40:23 UTC (rev 7299)
@@ -11,8 +11,11 @@
 
     * 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
 

Modified: Mouse/trunk/lib/Mouse/Meta/Class.pm
===================================================================
--- Mouse/trunk/lib/Mouse/Meta/Class.pm	2009-01-12 21:47:55 UTC (rev 7298)
+++ Mouse/trunk/lib/Mouse/Meta/Class.pm	2009-01-13 17:40:23 UTC (rev 7299)
@@ -160,37 +160,68 @@
 
 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} }