From: Tomas Doran <bobtfish@bobtfish.net>
Date: Wed, 22 Oct 2008 20:01:57 +0000 (+0000)
Subject: Speedups in does for MooseX::Storage, should also make protocol buffers suck less... 
X-Git-Tag: 0.60~22
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b8e4461e33e54dbc0f1545dccf21fcee7dc38550;p=gitmo%2FMoose.git

Speedups in does for MooseX::Storage, should also make protocol buffers suck less. WARNING: Relies on trunk CMOP, I've bumped versions so people should notice.
---

diff --git a/Changes b/Changes
index 3d7b7a0..2ea489a 100644
--- a/Changes
+++ b/Changes
@@ -5,6 +5,14 @@ Revision history for Perl extension Moose
       - Passing "-traits" when loading Moose caused the Moose.pm
         exports to be broken. Reported by t0m. (Dave Rolsky)
         - Tests for this bug. (t0m)
+    
+    * Moose::Util
+      - Change resolve_metaclass alias to use the new 
+        load_first_existing_class function. This makes it a lot
+        simpler, and also around 5 times faster. (t0m)
+      - Add caching to resolve_metatrait_alias, which gives an
+        order of magnitude speedup to things which repeatedly call 
+        the does method. E.g. MooseX::Storage (t0m)
 
 0.59 Tue October 14, 2008
     * Moose
diff --git a/Makefile.PL b/Makefile.PL
index 3c5a90e..a06f803 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -15,7 +15,7 @@ my $win32 = !! ( $^O eq 'Win32' or $^O eq 'cygwin' );
 requires 'perl'             => '5.008';
 requires 'Scalar::Util' => $win32 ? '1.17' : '1.18';
 requires 'Carp';
-requires 'Class::MOP'       => '0.67';
+requires 'Class::MOP'       => '0.68';
 requires 'List::MoreUtils';
 requires 'Sub::Exporter'    => '0.972';
 
diff --git a/lib/Moose/Util.pm b/lib/Moose/Util.pm
index 59ef18b..2f66c0d 100644
--- a/lib/Moose/Util.pm
+++ b/lib/Moose/Util.pm
@@ -118,27 +118,28 @@ sub get_all_init_args {
     };
 }
 
-sub resolve_metatrait_alias {
-    resolve_metaclass_alias( @_, trait => 1 );
+{   my %cache;
+    sub resolve_metatrait_alias {
+        my ( $type, $metaclass_name ) = @_;
+        
+        return $cache{$type}{$metaclass_name} if $cache{$type}{$metaclass_name};
+        
+        my $class = resolve_metaclass_alias( @_, trait => 1 );
+        $cache{$type}{$metaclass_name} = $class if $class;
+        
+        return $class;
+    }
 }
 
 sub resolve_metaclass_alias {
     my ( $type, $metaclass_name, %options ) = @_;
 
-    if ( my $resolved = eval {
-        my $possible_full_name = 'Moose::Meta::' . $type . '::Custom::' . ( $options{trait} ? "Trait::" : "" ) . $metaclass_name;
-
-        Class::MOP::load_class($possible_full_name);
+    my $possible_full_name = 'Moose::Meta::' . $type . '::Custom::' . ( $options{trait} ? "Trait::" : "" ) . $metaclass_name;
+    my $loaded_class = Class::MOP::load_first_existing_class($possible_full_name, $metaclass_name);
 
-        $possible_full_name->can('register_implementation')
-            ? $possible_full_name->register_implementation
-            : $possible_full_name;
-    } ) {
-        return $resolved;
-    } else {
-        Class::MOP::load_class($metaclass_name);
-        return $metaclass_name;
-    }
+    $loaded_class->can('register_implementation')
+        ? $loaded_class->register_implementation
+        : $loaded_class;
 }
 
 sub add_method_modifier {