bump version to 0.93_03
[gitmo/Moose.git] / lib / Moose / Meta / Role / Application / ToInstance.pm
CommitLineData
fb1e11d5 1package Moose::Meta::Role::Application::ToInstance;
2
3use strict;
4use warnings;
5use metaclass;
6
9b28d20b 7use Scalar::Util 'blessed';
fb1e11d5 8
7a10df4d 9our $VERSION = '0.93_03';
e606ae5f 10$VERSION = eval $VERSION;
fb1e11d5 11our $AUTHORITY = 'cpan:STEVAN';
12
1c9db35c 13use base 'Moose::Meta::Role::Application::ToClass';
14
3a79f0e9 15__PACKAGE__->meta->add_attribute('rebless_params' => (
16 reader => 'rebless_params',
17 default => sub { {} }
18));
19
d71ba374 20my %ANON_CLASSES;
1c9db35c 21
22sub apply {
23 my ($self, $role, $object) = @_;
24
d71ba374 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 {
37b3097c 32 my $obj_meta = Class::MOP::class_of($object) || 'Moose::Meta::Class';
f785aad8 33
34 # This is a special case to handle the case where the object's
35 # metaclass is a Class::MOP::Class, but _not_ a Moose::Meta::Class
36 # (for example, when applying a role to a Moose::Meta::Attribute
37 # object).
38 $obj_meta = 'Moose::Meta::Class'
39 unless $obj_meta->isa('Moose::Meta::Class');
40
c87f0c7f 41 $class = $obj_meta->create_anon_class(
d71ba374 42 superclasses => [ blessed($object) ]
43 );
44 $ANON_CLASSES{$anon_role_key} = $class;
45 $self->SUPER::apply($role, $class);
46 }
47
3a79f0e9 48 $class->rebless_instance($object, %{$self->rebless_params});
1c9db35c 49}
fb1e11d5 50
511;
52
53__END__
54
55=pod
56
57=head1 NAME
58
ab76842e 59Moose::Meta::Role::Application::ToInstance - Compose a role into an instance
fb1e11d5 60
61=head1 DESCRIPTION
62
63=head2 METHODS
64
65=over 4
66
67=item B<new>
68
69=item B<meta>
70
1c9db35c 71=item B<apply>
72
3a79f0e9 73=item B<rebless_params>
74
fb1e11d5 75=back
76
77=head1 BUGS
78
d4048ef3 79See L<Moose/BUGS> for details on reporting bugs.
fb1e11d5 80
81=head1 AUTHOR
82
83Stevan Little E<lt>stevan@iinteractive.comE<gt>
84
85=head1 COPYRIGHT AND LICENSE
86
7e0492d3 87Copyright 2006-2010 by Infinity Interactive, Inc.
fb1e11d5 88
89L<http://www.iinteractive.com>
90
91This library is free software; you can redistribute it and/or modify
92it under the same terms as Perl itself.
93
94=cut
95