From: Jesse Luehrs <doy@tozt.net>
Date: Fri, 6 May 2011 04:37:42 +0000 (-0500)
Subject: handle caching of anon classes better, when role/class params are used
X-Git-Tag: 2.0100~174
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=83dcb8665835751e1c79b6e44df247d25cd256fd;p=gitmo%2FMoose.git

handle caching of anon classes better, when role/class params are used
---

diff --git a/lib/Class/MOP/Package.pm b/lib/Class/MOP/Package.pm
index 2aada01..cca1cb6 100644
--- a/lib/Class/MOP/Package.pm
+++ b/lib/Class/MOP/Package.pm
@@ -100,7 +100,10 @@ sub create {
         my $cache_key;
         if ($cache_ok) {
             $cache_key = $class->_anon_cache_key(%options);
+            undef $cache_ok if !defined($cache_key);
+        }
 
+        if ($cache_ok) {
             if (defined $ANON_PACKAGE_CACHE{$cache_key}) {
                 return $ANON_PACKAGE_CACHE{$cache_key};
             }
diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm
index b3e95e4..52c9676 100644
--- a/lib/Moose/Meta/Class.pm
+++ b/lib/Moose/Meta/Class.pm
@@ -103,11 +103,50 @@ sub _anon_package_prefix { 'Moose::Meta::Class::__ANON__::SERIAL::' }
 sub _anon_cache_key {
     my $class = shift;
     my %options = @_;
-    # Makes something like Super::Class|Super::Class::2=Role|Role::1
-    return join '=' => (
-        join( '|', @{ $options{superclasses} || [] } ),
-        join( '|', sort @{ $options{roles}   || [] } ),
+
+    my $superclass_key = join('|',
+        map { $_->[0] } @{ Data::OptList::mkopt($options{superclasses} || []) }
     );
+
+    my $roles = Data::OptList::mkopt(($options{roles} || []), {
+        moniker  => 'role',
+        val_test => sub { ref($_[0]) eq 'HASH' },
+    });
+
+    my @role_keys;
+    for my $role_spec (@$roles) {
+        my ($role, $params) = @$role_spec;
+        $params = { %$params } if $params;
+
+        my $key = blessed($role) ? $role->name : $role;
+
+        if ($params && %$params) {
+            my $alias    = delete $params->{'-alias'}
+                        || delete $params->{'alias'}
+                        || {};
+            my $excludes = delete $params->{'-excludes'}
+                        || delete $params->{'excludes'}
+                        || [];
+            $excludes = [$excludes] unless ref($excludes) eq 'ARRAY';
+
+            if (%$params) {
+                warn "Roles with parameters cannot be cached. Consider "
+                   . "applying the parameters before calling "
+                   . "create_anon_class, or using 'weaken => 0' instead";
+                return;
+            }
+
+            $key .= '<' . join('+', 'a', join('%', %$alias),
+                                    'e', join('%', @$excludes)) . '>';
+        }
+
+        push @role_keys, $key;
+    }
+
+    my $role_key = join('|', @role_keys);
+
+    # Makes something like Super::Class|Super::Class::2=Role|Role::1
+    return join('=', $superclass_key, $role_key);
 }
 
 sub reinitialize {
diff --git a/lib/Moose/Meta/Role.pm b/lib/Moose/Meta/Role.pm
index 4e6eee8..af4c774 100644
--- a/lib/Moose/Meta/Role.pm
+++ b/lib/Moose/Meta/Role.pm
@@ -582,10 +582,45 @@ sub is_anon_role     { shift->is_anon(@_)     }
 sub _anon_cache_key {
     my $class = shift;
     my %options = @_;
+
+    # XXX fix this duplication (see MMC::_anon_cache_key
+    my $roles = Data::OptList::mkopt(($options{roles} || []), {
+        moniker  => 'role',
+        val_test => sub { ref($_[0]) eq 'HASH' },
+    });
+
+    my @role_keys;
+    for my $role_spec (@$roles) {
+        my ($role, $params) = @$role_spec;
+        $params = { %$params };
+
+        my $key = blessed($role) ? $role->name : $role;
+
+        if ($params && %$params) {
+            my $alias    = delete $params->{'-alias'}
+                        || delete $params->{'alias'}
+                        || {};
+            my $excludes = delete $params->{'-excludes'}
+                        || delete $params->{'excludes'}
+                        || [];
+            $excludes = [$excludes] unless ref($excludes) eq 'ARRAY';
+
+            if (%$params) {
+                warn "Roles with parameters cannot be cached. Consider "
+                   . "applying the parameters before calling "
+                   . "create_anon_class, or using 'weaken => 0' instead";
+                return;
+            }
+
+            $key .= '<' . join('+', 'a', join('%', %$alias),
+                                    'e', join('%', @$excludes)) . '>';
+        }
+
+        push @role_keys, $key;
+    }
+
     # Makes something like Role|Role::1
-    return join '=' => (
-        join( '|', sort @{ $options{roles} || [] } ),
-    );
+    return join('|', @role_keys);
 }
 
 #####################################################################
diff --git a/lib/Moose/Meta/Role/Application/ToInstance.pm b/lib/Moose/Meta/Role/Application/ToInstance.pm
index 81ce0c4..1f12e5f 100644
--- a/lib/Moose/Meta/Role/Application/ToInstance.pm
+++ b/lib/Moose/Meta/Role/Application/ToInstance.pm
@@ -5,6 +5,7 @@ use warnings;
 use metaclass;
 
 use Scalar::Util 'blessed';
+use List::MoreUtils 'all';
 
 use base 'Moose::Meta::Role::Application';
 
@@ -27,7 +28,7 @@ sub apply {
     my $class = $obj_meta->create_anon_class(
         superclasses => [ blessed($object) ],
         roles => [ $role, keys(%$args) ? ($args) : () ],
-        cache => 1,
+        cache => (all { $_ eq '-alias' || $_ eq '-excludes' } keys %$args),
     );
 
     $class->rebless_instance( $object, %{ $self->rebless_params } );