__expand_role for "foreign" and parameterized roles

* =Foo::Format::Foo for an absolute role name
* [ ParamRole => $args ] for a param-ed role

diff --git a/Changes b/Changes
index 30d336c..a3c665f 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,6 +1,8 @@
 Revision history for MooseX-Storage
 
   * Fix warnings when types do not have a parent type.
+  * allow the use of roles outside MooseX::Storage:: (rjbs)
+  * allow the use of parameterized roles (rjbs)
 
 0.21
   * Fix inconsistent dist versions with Perl::Version

diff --git a/lib/MooseX/Storage.pm b/lib/MooseX/Storage.pm
index dbbdf85..86b5858 100644 (file)
--- a/lib/MooseX/Storage.pm
+++ b/lib/MooseX/Storage.pm
@@ -19,21 +19,35 @@ sub import {
     $pkg->meta->add_method('Storage' => __PACKAGE__->meta->find_method_by_name('_injected_storage_role_generator'));
 }
 
+my %HORRIBLE_GC_AVOIDANCE_HACK;
+
 sub __expand_role {
     my ($base, $value) = @_;
 
     return unless defined $value;
 
     if (ref $value) {
-        confess "references for roles are not yet handled";
+        my ($class, $param, $no) = @$value;
+        confess "too many args in arrayref role declaration" if defined $no;
+
+        $class = __expand_role($base => $class);
+        Class::MOP::load_class($class);
+
+        my $role = $class->meta->generate_role(parameters => $param);
+
+        $HORRIBLE_GC_AVOIDANCE_HACK{ $role->name } = $role;
+        return $role->name;
     } else {
-        return scalar String::RewritePrefix->rewrite(
+        my $role = scalar String::RewritePrefix->rewrite(
             {
                 ''  => "MooseX::Storage::$base\::",
                 '=' => '',
             },
             $value,
         );
+
+        Class::MOP::load_class($role);
+        return $role;
     }
 }
 
@@ -70,10 +84,6 @@ sub _injected_storage_role_generator {
         push @roles, __expand_role(Traits => $trait);
     }
 
-    for my $role ( @roles ) {
-        Class::MOP::load_class($role) or die "Could not load role ($role)";
-    }
-
     return @roles;
 }
 

diff --git a/t/012_param_json.t b/t/012_param_json.t
new file mode 100644 (file)
index 0000000..5ce5c24
--- /dev/null
+++ b/t/012_param_json.t
@@ -0,0 +1,46 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+BEGIN {        
+    local $@;
+    plan skip_all => "MooseX::Storage::Format::JSONpm required for this test"
+        unless eval "require MooseX::Storage::Format::JSONpm; 1";
+}
+
+plan tests => 3;
+use_ok('MooseX::Storage');
+
+{
+
+    package Foo;
+    use Moose;
+    use MooseX::Storage;
+
+    with Storage(format => [ JSONpm => { json_opts => { pretty => 1 } } ] );
+    # with Storage(format => 'JSONpm');
+
+    has 'string' => ( is => 'ro', isa => 'Str' );
+    has 'float'  => ( is => 'ro', isa => 'Num' );
+}
+
+{
+    my $foo = Foo->new(
+        string => 'foo',
+        float  => 10.5,
+    );
+    isa_ok( $foo, 'Foo' );
+
+    my $json = $foo->freeze;
+
+    isnt(
+        index($json, "\n"),
+        -1,
+        "there are newlines in our JSON, because it is pretty",
+    ) or diag $json;
+
+}
+