From: Ricardo Signes <rjbs@cpan.org>
Date: Fri, 2 Apr 2010 16:44:21 +0000 (-0400)
Subject: allow deferred to use parameterized roles
X-Git-Tag: 0.27~3
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=61fb1aaaf5a1cc17e1ae52779e36373aa0bbd70a;p=gitmo%2FMooseX-Storage.git

allow deferred to use parameterized roles
---

diff --git a/lib/MooseX/Storage.pm b/lib/MooseX/Storage.pm
index 78c898b..1aa4674 100644
--- a/lib/MooseX/Storage.pm
+++ b/lib/MooseX/Storage.pm
@@ -21,16 +21,28 @@ sub import {
 
 my %HORRIBLE_GC_AVOIDANCE_HACK;
 
-sub __expand_role {
-    my ($base, $value) = @_;
+sub _rewrite_role_name {
+    my ($self, $base, $string) = @_;
+
+    my $role_name = scalar String::RewritePrefix->rewrite(
+        {
+            ''  => "MooseX::Storage::$base\::",
+            '=' => '',
+        },
+        $string,
+    );
+}
+
+sub _expand_role {
+    my ($self, $base, $value) = @_;
 
     return unless defined $value;
 
     if (ref $value) {
-        my ($class, $param, $no) = @$value;
-        confess "too many args in arrayref role declaration" if defined $no;
+        confess "too many args in arrayref role declaration" if @$value > 2;
+        my ($class, $param) = @$value;
 
-        $class = __expand_role($base => $class);
+        $class = $self->_rewrite_role_name($base => $class);
         Class::MOP::load_class($class);
 
         my $role = $class->meta->generate_role(parameters => $param);
@@ -38,16 +50,20 @@ sub __expand_role {
         $HORRIBLE_GC_AVOIDANCE_HACK{ $role->name } = $role;
         return $role->name;
     } else {
-        my $role = scalar String::RewritePrefix->rewrite(
-            {
-                ''  => "MooseX::Storage::$base\::",
-                '=' => '',
-            },
-            $value,
-        );
-
-        Class::MOP::load_class($role);
-        return $role;
+        my $class = $self->_rewrite_role_name($base, $value);
+        Class::MOP::load_class($class);
+
+        my $role = $class;
+
+        if ($class->meta->isa(
+            'MooseX::Role::Parameterized::Meta::Role::Parameterizable'
+        )) {
+            $role = $class->meta->generate_role(parameters => undef);
+            $HORRIBLE_GC_AVOIDANCE_HACK{ $role->name } = $role;
+            return $role->name;
+        }
+
+        return $class;
     }
 }
 
@@ -56,13 +72,13 @@ sub _injected_storage_role_generator {
 
     $params{base} = '=MooseX::Storage::Basic' unless defined $params{base};
 
-    my @roles = __expand_role(Base => $params{base});
+    my @roles = __PACKAGE__->_expand_role(Base => $params{base});
 
     # NOTE:
     # you don't have to have a format
     # role, this just means you dont
     # get anything other than pack/unpack
-    push @roles, __expand_role(Format => $params{format});
+    push @roles, __PACKAGE__->_expand_role(Format => $params{format});
 
     # NOTE:
     # many IO roles don't make sense unless
@@ -75,13 +91,13 @@ sub _injected_storage_role_generator {
     # us. This allows the StorableFile to work
     #(exists $params{'format'})
     #    || confess "You must specify a format role in order to use an IO role";
-    push @roles, __expand_role(IO => $params{io});
+    push @roles, __PACKAGE__->_expand_role(IO => $params{io});
 
     # Note:
     # These traits alter the behaviour of the engine, the user can
     # specify these per role-usage
     for my $trait ( @{ $params{'traits'} ||= [] } ) {
-        push @roles, __expand_role(Traits => $trait);
+        push @roles, __PACKAGE__->_expand_role(Traits => $trait);
     }
 
     return @roles;
diff --git a/lib/MooseX/Storage/Deferred.pm b/lib/MooseX/Storage/Deferred.pm
index 0e8cb10..1e34f16 100644
--- a/lib/MooseX/Storage/Deferred.pm
+++ b/lib/MooseX/Storage/Deferred.pm
@@ -6,18 +6,22 @@ our $AUTHORITY = 'cpan:STEVAN';
 
 with 'MooseX::Storage::Basic';
 
+sub __get_method {
+    my ( $self, $basename, $value, $method_name ) = @_;
+
+    my $role   = MooseX::Storage->_expand_role($basename => $value)->meta;
+    my $method = $role->get_method($method_name)->body;
+}
+
 sub thaw {
     my ( $class, $packed, $type, @args ) = @_;
 
     (exists $type->{format})
         || confess "You must specify a format type to thaw from";
 
-    my $class_to_load = 'MooseX::Storage::Format::' . $type->{format};
-    Class::MOP::load_class($class_to_load);
-
-    my $method_to_call = $class_to_load . '::thaw';
+    my $code = $class->__get_method(Format => $type->{format} => 'thaw');
 
-    $class->$method_to_call($packed, @args);
+    $class->$code($packed, @args);
 }
 
 sub freeze {
@@ -26,12 +30,9 @@ sub freeze {
     (exists $type->{format})
         || confess "You must specify a format type to freeze into";
 
-    my $class_to_load = 'MooseX::Storage::Format::' . $type->{format};
-    Class::MOP::load_class($class_to_load);
+    my $code = $self->__get_method(Format => $type->{format} => 'freeze');
 
-    my $method_to_call = $class_to_load . '::freeze';
-
-    $self->$method_to_call(@args);
+    $self->$code(@args);
 }
 
 sub load {
@@ -40,12 +41,9 @@ sub load {
     (exists $type->{io})
         || confess "You must specify an I/O type to load with";
 
-    my $class_to_load = 'MooseX::Storage::IO::' . $type->{io};
-    Class::MOP::load_class($class_to_load);
-
-    my $method_to_call = $class_to_load . '::load';
+    my $code = $class->__get_method(IO => $type->{io} => 'load');
 
-    $class->$method_to_call($filename, $type, @args);
+    $class->$code($filename, $type, @args);
 }
 
 sub store {
@@ -54,12 +52,9 @@ sub store {
     (exists $type->{io})
         || confess "You must specify an I/O type to store with";
 
-    my $class_to_load = 'MooseX::Storage::IO::' . $type->{io};
-    Class::MOP::load_class($class_to_load);
-
-    my $method_to_call = $class_to_load . '::store';
+    my $code = $self->__get_method(IO => $type->{io} => 'store');
 
-    $self->$method_to_call($filename, $type, @args);
+    $self->$code($filename, $type, @args);
 }
 
 no Moose::Role;