bump version to 1.12
[gitmo/Moose.git] / lib / Moose / Meta / Role / Composite.pm
CommitLineData
fb1e11d5 1package Moose::Meta::Role::Composite;
2
3use strict;
4use warnings;
5use metaclass;
6
21f1e231 7use Scalar::Util 'blessed';
fb1e11d5 8
55d05fb1 9our $VERSION = '1.12';
e606ae5f 10$VERSION = eval $VERSION;
fb1e11d5 11our $AUTHORITY = 'cpan:STEVAN';
12
13use base 'Moose::Meta::Role';
14
15# NOTE:
d03bd989 16# we need to override the ->name
fb1e11d5 17# method from Class::MOP::Package
d03bd989 18# since we don't have an actual
fb1e11d5 19# package for this.
20# - SL
21__PACKAGE__->meta->add_attribute('name' => (reader => 'name'));
22
23# NOTE:
d03bd989 24# Again, since we don't have a real
25# package to store our methods in,
26# we use a HASH ref instead.
fb1e11d5 27# - SL
0385d05e 28__PACKAGE__->meta->add_attribute('_methods' => (
29 reader => '_method_map',
fb1e11d5 30 default => sub { {} }
31));
32
7071e2cb 33__PACKAGE__->meta->add_attribute(
34 'application_role_summation_class',
35 reader => 'application_role_summation_class',
36 default => 'Moose::Meta::Role::Application::RoleSummation',
37);
38
fb1e11d5 39sub new {
40 my ($class, %params) = @_;
12d8c847 41
fb1e11d5 42 # the roles param is required ...
70ea9161 43 foreach ( @{$params{roles}} ) {
44 unless ( $_->isa('Moose::Meta::Role') ) {
45 require Moose;
46 Moose->throw_error("The list of roles must be instances of Moose::Meta::Role, not $_");
47 }
48 }
12d8c847 49
50 my @composition_roles = map {
4701ceff 51 $_->composition_class_roles
12d8c847 52 } @{ $params{roles} };
53
54 if (@composition_roles) {
55 my $meta = Moose::Meta::Class->create_anon_class(
56 superclasses => [ $class ],
57 roles => [ @composition_roles ],
58 cache => 1,
59 );
60 $meta->add_method(meta => sub { $meta });
61 $class = $meta->name;
62 }
63
fb1e11d5 64 # and the name is created from the
65 # roles if one has not been provided
66 $params{name} ||= (join "|" => map { $_->name } @{$params{roles}});
e606ae5f 67 $class->_new(\%params);
fb1e11d5 68}
69
87e63626 70# This is largely a cope of what's in Moose::Meta::Role (itself
71# largely a copy of Class::MOP::Class). However, we can't actually
72# call add_package_symbol, because there's no package to which which
73# add the symbol.
74sub add_method {
fb1e11d5 75 my ($self, $method_name, $method) = @_;
70ea9161 76
77 unless ( defined $method_name && $method_name ) {
78 Moose->throw_error("You must define a method name");
79 }
87e63626 80
81 my $body;
82 if (blessed($method)) {
83 $body = $method->body;
84 if ($method->package_name ne $self->name) {
85 $method = $method->clone(
86 package_name => $self->name,
d03bd989 87 name => $method_name
87e63626 88 ) if $method->can('clone');
89 }
90 }
91 else {
92 $body = $method;
93 $method = $self->wrap_method_body( body => $body, name => $method_name );
94 }
fb1e11d5 95
0385d05e 96 $self->_method_map->{$method_name} = $method;
97}
98
99sub get_method_list {
100 my $self = shift;
101 return keys %{ $self->_method_map };
102}
103
723576c6 104sub _get_local_methods {
105 my $self = shift;
106 return values %{ $self->_method_map };
107}
108
0385d05e 109sub has_method {
110 my ($self, $method_name) = @_;
111
112 return exists $self->_method_map->{$method_name};
113}
114
115sub get_method {
116 my ($self, $method_name) = @_;
117
118 return $self->_method_map->{$method_name};
fb1e11d5 119}
120
7071e2cb 121sub apply_params {
122 my ($self, $role_params) = @_;
123 Class::MOP::load_class($self->application_role_summation_class);
124
125 $self->application_role_summation_class->new(
126 role_params => $role_params,
127 )->apply($self);
128
129 return $self;
130}
131
6e04cb0e 132sub reinitialize {
f785aad8 133 my ( $class, $old_meta, @args ) = @_;
134
135 Moose->throw_error(
136 'Moose::Meta::Role::Composite instances can only be reinitialized from an existing metaclass instance'
137 )
138 if !blessed $old_meta
139 || !$old_meta->isa('Moose::Meta::Role::Composite');
140
141 my %existing_classes = map { $_ => $old_meta->$_() } qw(
142 application_role_summation_class
143 );
144
145 return $old_meta->meta->clone_object( $old_meta, %existing_classes, @args );
6e04cb0e 146}
147
fb1e11d5 1481;
149
150__END__
151
152=pod
153
154=head1 NAME
155
156Moose::Meta::Role::Composite - An object to represent the set of roles
157
158=head1 DESCRIPTION
159
da5cc486 160A composite is a role that consists of a set of two or more roles.
161
162The API of a composite role is almost identical to that of a regular
163role.
164
165=head1 INHERITANCE
166
167C<Moose::Meta::Role::Composite> is a subclass of L<Moose::Meta::Role>.
168
fb1e11d5 169=head2 METHODS
170
171=over 4
172
da5cc486 173=item B<< Moose::Meta::Role::Composite->new(%options) >>
fb1e11d5 174
da5cc486 175This returns a new composite role object. It accepts the same
176options as its parent class, with a few changes:
fb1e11d5 177
da5cc486 178=over 8
fb1e11d5 179
da5cc486 180=item * roles
fb1e11d5 181
da5cc486 182This option is an array reference containing a list of
183L<Moose::Meta::Role> object. This is a required option.
184
185=item * name
186
187If a name is not given, one is generated from the roles provided.
188
7071e2cb 189=item * apply_params(\%role_params)
190
191Creates a new RoleSummation role application with C<%role_params> and applies
192the composite role to it. The RoleSummation role application class used is
193determined by the composite role's C<application_role_summation_class>
194attribute.
195
6e04cb0e 196=item * reinitialize($metaclass)
197
198Like C<< Class::MOP::Package->reinitialize >>, but doesn't allow passing a
199string with the package name, as there is no real package for composite roles.
200
da5cc486 201=back
fb1e11d5 202
203=back
204
205=head1 BUGS
206
d4048ef3 207See L<Moose/BUGS> for details on reporting bugs.
fb1e11d5 208
209=head1 AUTHOR
210
211Stevan Little E<lt>stevan@iinteractive.comE<gt>
212
213=head1 COPYRIGHT AND LICENSE
214
7e0492d3 215Copyright 2006-2010 by Infinity Interactive, Inc.
fb1e11d5 216
217L<http://www.iinteractive.com>
218
219This library is free software; you can redistribute it and/or modify
220it under the same terms as Perl itself.
221
e606ae5f 222=cut