adding in the ability to pass params to rebles when doing runtime roles
[gitmo/Moose.git] / lib / Moose / Meta / Role / Application / ToInstance.pm
1 package Moose::Meta::Role::Application::ToInstance;
2
3 use strict;
4 use warnings;
5 use metaclass;
6
7 use Carp         'confess';
8 use Scalar::Util 'blessed';
9
10 our $VERSION   = '0.02';
11 our $AUTHORITY = 'cpan:STEVAN';
12
13 use base 'Moose::Meta::Role::Application::ToClass';
14
15 __PACKAGE__->meta->add_attribute('rebless_params' => (
16     reader  => 'rebless_params',
17     default => sub { {} }
18 ));
19
20 my %ANON_CLASSES;
21
22 sub apply {
23     my ($self, $role, $object) = @_;
24
25     my $anon_role_key = (blessed($object) . $role->name);
26
27     my $class;
28     if (exists $ANON_CLASSES{$anon_role_key} && defined $ANON_CLASSES{$anon_role_key}) {
29         $class = $ANON_CLASSES{$anon_role_key};
30     }
31     else {
32         $class = Moose::Meta::Class->create_anon_class(
33             superclasses => [ blessed($object) ]
34         );
35         $ANON_CLASSES{$anon_role_key} = $class;
36         $self->SUPER::apply($role, $class);
37     }
38
39     $class->rebless_instance($object, %{$self->rebless_params});
40 }
41
42 1;
43
44 __END__
45
46 =pod
47
48 =head1 NAME
49
50 Moose::Meta::Role::Application::ToInstance - Compose a role into an instance
51
52 =head1 DESCRIPTION
53
54 =head2 METHODS
55
56 =over 4
57
58 =item B<new>
59
60 =item B<meta>
61
62 =item B<apply>
63
64 =item B<rebless_params>
65
66 =back
67
68 =head1 BUGS
69
70 All complex software has bugs lurking in it, and this module is no
71 exception. If you find a bug please either email me, or add the bug
72 to cpan-RT.
73
74 =head1 AUTHOR
75
76 Stevan Little E<lt>stevan@iinteractive.comE<gt>
77
78 =head1 COPYRIGHT AND LICENSE
79
80 Copyright 2006-2008 by Infinity Interactive, Inc.
81
82 L<http://www.iinteractive.com>
83
84 This library is free software; you can redistribute it and/or modify
85 it under the same terms as Perl itself.
86
87 =cut
88