1 package Moose::Meta::Role::Composite;
7 use Scalar::Util 'blessed';
10 $VERSION = eval $VERSION;
11 our $AUTHORITY = 'cpan:STEVAN';
13 use base 'Moose::Meta::Role';
16 # we need to override the ->name
17 # method from Class::MOP::Package
18 # since we don't have an actual
21 __PACKAGE__->meta->add_attribute('name' => (reader => 'name'));
24 # Again, since we don't have a real
25 # package to store our methods in,
26 # we use a HASH ref instead.
28 __PACKAGE__->meta->add_attribute('_methods' => (
29 reader => '_method_map',
33 __PACKAGE__->meta->add_attribute(
34 'application_role_summation_class',
35 reader => 'application_role_summation_class',
36 default => 'Moose::Meta::Role::Application::RoleSummation',
40 my ($class, %params) = @_;
42 # the roles param is required ...
43 foreach ( @{$params{roles}} ) {
44 unless ( $_->isa('Moose::Meta::Role') ) {
46 Moose->throw_error("The list of roles must be instances of Moose::Meta::Role, not $_");
50 my @composition_roles = map {
51 $_->has_composition_class_roles
52 ? @{ $_->composition_class_roles }
54 } @{ $params{roles} };
56 if (@composition_roles) {
57 my $meta = Moose::Meta::Class->create_anon_class(
58 superclasses => [ $class ],
59 roles => [ @composition_roles ],
62 $meta->add_method(meta => sub { $meta });
66 # and the name is created from the
67 # roles if one has not been provided
68 $params{name} ||= (join "|" => map { $_->name } @{$params{roles}});
69 $class->_new(\%params);
72 # This is largely a cope of what's in Moose::Meta::Role (itself
73 # largely a copy of Class::MOP::Class). However, we can't actually
74 # call add_package_symbol, because there's no package to which which
77 my ($self, $method_name, $method) = @_;
79 unless ( defined $method_name && $method_name ) {
80 Moose->throw_error("You must define a method name");
84 if (blessed($method)) {
85 $body = $method->body;
86 if ($method->package_name ne $self->name) {
87 $method = $method->clone(
88 package_name => $self->name,
90 ) if $method->can('clone');
95 $method = $self->wrap_method_body( body => $body, name => $method_name );
98 $self->_method_map->{$method_name} = $method;
101 sub get_method_list {
103 return keys %{ $self->_method_map };
107 my ($self, $method_name) = @_;
109 return exists $self->_method_map->{$method_name};
113 my ($self, $method_name) = @_;
115 return $self->_method_map->{$method_name};
119 my ($self, $role_params) = @_;
120 Class::MOP::load_class($self->application_role_summation_class);
122 $self->application_role_summation_class->new(
123 role_params => $role_params,
130 my ($class, $old_meta, @args) = @_;
131 Moose->throw_error('Moose::Meta::Role::Composite instances can only be reinitialized from an existing metaclass instance')
132 if !blessed $old_meta || !$old_meta->isa('Moose::Meta::Role::Composite');
133 return $old_meta->meta->clone_object($old_meta, @args);
144 Moose::Meta::Role::Composite - An object to represent the set of roles
148 A composite is a role that consists of a set of two or more roles.
150 The API of a composite role is almost identical to that of a regular
155 C<Moose::Meta::Role::Composite> is a subclass of L<Moose::Meta::Role>.
161 =item B<< Moose::Meta::Role::Composite->new(%options) >>
163 This returns a new composite role object. It accepts the same
164 options as its parent class, with a few changes:
170 This option is an array reference containing a list of
171 L<Moose::Meta::Role> object. This is a required option.
175 If a name is not given, one is generated from the roles provided.
177 =item * apply_params(\%role_params)
179 Creates a new RoleSummation role application with C<%role_params> and applies
180 the composite role to it. The RoleSummation role application class used is
181 determined by the composite role's C<application_role_summation_class>
184 =item * reinitialize($metaclass)
186 Like C<< Class::MOP::Package->reinitialize >>, but doesn't allow passing a
187 string with the package name, as there is no real package for composite roles.
195 All complex software has bugs lurking in it, and this module is no
196 exception. If you find a bug please either email me, or add the bug
201 Stevan Little E<lt>stevan@iinteractive.comE<gt>
203 =head1 COPYRIGHT AND LICENSE
205 Copyright 2006-2009 by Infinity Interactive, Inc.
207 L<http://www.iinteractive.com>
209 This library is free software; you can redistribute it and/or modify
210 it under the same terms as Perl itself.