adding in the ability to pass params to rebles when doing runtime roles

diff --git a/lib/Moose/Meta/Role/Application/ToInstance.pm b/lib/Moose/Meta/Role/Application/ToInstance.pm
index 50e367f..f0ed1a7 100644 (file)
--- a/lib/Moose/Meta/Role/Application/ToInstance.pm
+++ b/lib/Moose/Meta/Role/Application/ToInstance.pm
@@ -7,11 +7,16 @@ use metaclass;
 use Carp         'confess';
 use Scalar::Util 'blessed';
 
-our $VERSION   = '0.01';
+our $VERSION   = '0.02';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Moose::Meta::Role::Application::ToClass';
 
+__PACKAGE__->meta->add_attribute('rebless_params' => (
+    reader  => 'rebless_params',
+    default => sub { {} }
+));
+
 my %ANON_CLASSES;
 
 sub apply {
@@ -31,7 +36,7 @@ sub apply {
         $self->SUPER::apply($role, $class);
     }
 
-    $class->rebless_instance($object);
+    $class->rebless_instance($object, %{$self->rebless_params});
 }
 
 1;
@@ -56,6 +61,8 @@ Moose::Meta::Role::Application::ToInstance - Compose a role into an instance
 
 =item B<apply>
 
+=item B<rebless_params>
+
 =back
 
 =head1 BUGS

diff --git a/t/030_roles/018_runtime_roles_w_params.t b/t/030_roles/018_runtime_roles_w_params.t
new file mode 100644 (file)
index 0000000..44941ee
--- /dev/null
+++ b/t/030_roles/018_runtime_roles_w_params.t
@@ -0,0 +1,75 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 22;
+use Test::Exception;
+
+BEGIN {
+    use_ok('Moose');
+}
+
+{
+    package Foo;
+    use Moose;
+    has 'bar' => (is => 'ro');
+    
+    package Bar;
+    use Moose::Role;
+    
+    has 'baz' => (is => 'ro', default => 'BAZ');    
+}
+
+# normal ...
+{
+    my $foo = Foo->new(bar => 'BAR');
+    isa_ok($foo, 'Foo');
+
+    is($foo->bar, 'BAR', '... got the expect value');
+    ok(!$foo->can('baz'), '... no baz method though');
+
+    lives_ok {
+        Bar->meta->apply($foo)
+    } '... this works';
+
+    is($foo->bar, 'BAR', '... got the expect value');
+    ok($foo->can('baz'), '... we have baz method now');
+    is($foo->baz, 'BAZ', '... got the expect value');
+}
+
+# with extra params ...
+{
+    my $foo = Foo->new(bar => 'BAR');
+    isa_ok($foo, 'Foo');
+
+    is($foo->bar, 'BAR', '... got the expect value');
+    ok(!$foo->can('baz'), '... no baz method though');
+
+    lives_ok {
+        Bar->meta->apply($foo, (rebless_params => { baz => 'FOO-BAZ' }))
+    } '... this works';
+
+    is($foo->bar, 'BAR', '... got the expect value');
+    ok($foo->can('baz'), '... we have baz method now');
+    is($foo->baz, 'FOO-BAZ', '... got the expect value');
+}
+
+# with extra params ...
+{
+    my $foo = Foo->new(bar => 'BAR');
+    isa_ok($foo, 'Foo');
+
+    is($foo->bar, 'BAR', '... got the expect value');
+    ok(!$foo->can('baz'), '... no baz method though');
+
+    lives_ok {
+        Bar->meta->apply($foo, (rebless_params => { bar => 'FOO-BAR', baz => 'FOO-BAZ' }))
+    } '... this works';
+
+    is($foo->bar, 'FOO-BAR', '... got the expect value');
+    ok($foo->can('baz'), '... we have baz method now');
+    is($foo->baz, 'FOO-BAZ', '... got the expect value');
+}
+
+