lib/Moose/Meta/Role/Composite.pm

   1 package Moose::Meta::Role::Composite;
   2
   3 use strict;
   4 use warnings;
   5 use metaclass;
   6
   7 use Scalar::Util 'blessed';
   8
   9 our $VERSION   = '0.93';
  10 $VERSION = eval $VERSION;
  11 our $AUTHORITY = 'cpan:STEVAN';
  12
  13 use base 'Moose::Meta::Role';
  14
  15 # NOTE:
  16 # we need to override the ->name
  17 # method from Class::MOP::Package
  18 # since we don't have an actual
  19 # package for this.
  20 # - SL
  21 __PACKAGE__->meta->add_attribute('name' => (reader => 'name'));
  22
  23 # NOTE:
  24 # Again, since we don't have a real
  25 # package to store our methods in,
  26 # we use a HASH ref instead.
  27 # - SL
  28 __PACKAGE__->meta->add_attribute('_methods' => (
  29     reader  => '_method_map',
  30     default => sub { {} }
  31 ));
  32
  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
  39 sub new {
  40     my ($class, %params) = @_;
  41
  42     # the roles param is required ...
  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     }
  49
  50     my @composition_roles = map {
  51         $_->has_composition_class_roles
  52             ? @{ $_->composition_class_roles }
  53             : ()
  54     } @{ $params{roles} };
  55
  56     if (@composition_roles) {
  57         my $meta = Moose::Meta::Class->create_anon_class(
  58             superclasses => [ $class ],
  59             roles        => [ @composition_roles ],
  60             cache        => 1,
  61         );
  62         $meta->add_method(meta => sub { $meta });
  63         $class = $meta->name;
  64     }
  65
  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);
  70 }
  71
  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
  75 # add the symbol.
  76 sub add_method {
  77     my ($self, $method_name, $method) = @_;
  78
  79     unless ( defined $method_name && $method_name ) {
  80         Moose->throw_error("You must define a method name");
  81     }
  82
  83     my $body;
  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,
  89                 name         => $method_name
  90             ) if $method->can('clone');
  91         }
  92     }
  93     else {
  94         $body = $method;
  95         $method = $self->wrap_method_body( body => $body, name => $method_name );
  96     }
  97
  98     $self->_method_map->{$method_name} = $method;
  99 }
 100
 101 sub get_method_list {
 102     my $self = shift;
 103     return keys %{ $self->_method_map };
 104 }
 105
 106 sub has_method {
 107     my ($self, $method_name) = @_;
 108
 109     return exists $self->_method_map->{$method_name};
 110 }
 111
 112 sub get_method {
 113     my ($self, $method_name) = @_;
 114
 115     return $self->_method_map->{$method_name};
 116 }
 117
 118 sub apply_params {
 119     my ($self, $role_params) = @_;
 120     Class::MOP::load_class($self->application_role_summation_class);
 121
 122     $self->application_role_summation_class->new(
 123         role_params => $role_params,
 124     )->apply($self);
 125
 126     return $self;
 127 }
 128
 129 sub reinitialize {
 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);
 134 }
 135
 136 1;
 137
 138 __END__
 139
 140 =pod
 141
 142 =head1 NAME
 143
 144 Moose::Meta::Role::Composite - An object to represent the set of roles
 145
 146 =head1 DESCRIPTION
 147
 148 A composite is a role that consists of a set of two or more roles.
 149
 150 The API of a composite role is almost identical to that of a regular
 151 role.
 152
 153 =head1 INHERITANCE
 154
 155 C<Moose::Meta::Role::Composite> is a subclass of L<Moose::Meta::Role>.
 156
 157 =head2 METHODS
 158
 159 =over 4
 160
 161 =item B<< Moose::Meta::Role::Composite->new(%options) >>
 162
 163 This returns a new composite role object. It accepts the same
 164 options as its parent class, with a few changes:
 165
 166 =over 8
 167
 168 =item * roles
 169
 170 This option is an array reference containing a list of
 171 L<Moose::Meta::Role> object. This is a required option.
 172
 173 =item * name
 174
 175 If a name is not given, one is generated from the roles provided.
 176
 177 =item * apply_params(\%role_params)
 178
 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>
 182 attribute.
 183
 184 =item * reinitialize($metaclass)
 185
 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.
 188
 189 =back
 190
 191 =back
 192
 193 =head1 BUGS
 194
 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
 197 to cpan-RT.
 198
 199 =head1 AUTHOR
 200
 201 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 202
 203 =head1 COPYRIGHT AND LICENSE
 204
 205 Copyright 2006-2009 by Infinity Interactive, Inc.
 206
 207 L<http://www.iinteractive.com>
 208
 209 This library is free software; you can redistribute it and/or modify
 210 it under the same terms as Perl itself.
 211
 212 =cut