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   = '1.10';
  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         $_->composition_class_roles
  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
  64     # and the name is created from the
  65     # roles if one has not been provided
  66     $params{name} ||= (join "|" => map { $_->name } @{$params{roles}});
  67     $class->_new(\%params);
  68 }
  69
  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.
  74 sub add_method {
  75     my ($self, $method_name, $method) = @_;
  76
  77     unless ( defined $method_name && $method_name ) {
  78         Moose->throw_error("You must define a method name");
  79     }
  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,
  87                 name         => $method_name
  88             ) if $method->can('clone');
  89         }
  90     }
  91     else {
  92         $body = $method;
  93         $method = $self->wrap_method_body( body => $body, name => $method_name );
  94     }
  95
  96     $self->_method_map->{$method_name} = $method;
  97 }
  98
  99 sub get_method_list {
 100     my $self = shift;
 101     return keys %{ $self->_method_map };
 102 }
 103
 104 sub _get_local_methods {
 105     my $self = shift;
 106     return values %{ $self->_method_map };
 107 }
 108
 109 sub has_method {
 110     my ($self, $method_name) = @_;
 111
 112     return exists $self->_method_map->{$method_name};
 113 }
 114
 115 sub get_method {
 116     my ($self, $method_name) = @_;
 117
 118     return $self->_method_map->{$method_name};
 119 }
 120
 121 sub 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
 132 sub reinitialize {
 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 );
 146 }
 147
 148 1;
 149
 150 __END__
 151
 152 =pod
 153
 154 =head1 NAME
 155
 156 Moose::Meta::Role::Composite - An object to represent the set of roles
 157
 158 =head1 DESCRIPTION
 159
 160 A composite is a role that consists of a set of two or more roles.
 161
 162 The API of a composite role is almost identical to that of a regular
 163 role.
 164
 165 =head1 INHERITANCE
 166
 167 C<Moose::Meta::Role::Composite> is a subclass of L<Moose::Meta::Role>.
 168
 169 =head2 METHODS
 170
 171 =over 4
 172
 173 =item B<< Moose::Meta::Role::Composite->new(%options) >>
 174
 175 This returns a new composite role object. It accepts the same
 176 options as its parent class, with a few changes:
 177
 178 =over 8
 179
 180 =item * roles
 181
 182 This option is an array reference containing a list of
 183 L<Moose::Meta::Role> object. This is a required option.
 184
 185 =item * name
 186
 187 If a name is not given, one is generated from the roles provided.
 188
 189 =item * apply_params(\%role_params)
 190
 191 Creates a new RoleSummation role application with C<%role_params> and applies
 192 the composite role to it. The RoleSummation role application class used is
 193 determined by the composite role's C<application_role_summation_class>
 194 attribute.
 195
 196 =item * reinitialize($metaclass)
 197
 198 Like C<< Class::MOP::Package->reinitialize >>, but doesn't allow passing a
 199 string with the package name, as there is no real package for composite roles.
 200
 201 =back
 202
 203 =back
 204
 205 =head1 BUGS
 206
 207 See L<Moose/BUGS> for details on reporting bugs.
 208
 209 =head1 AUTHOR
 210
 211 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 212
 213 =head1 COPYRIGHT AND LICENSE
 214
 215 Copyright 2006-2010 by Infinity Interactive, Inc.
 216
 217 L<http://www.iinteractive.com>
 218
 219 This library is free software; you can redistribute it and/or modify
 220 it under the same terms as Perl itself.
 221
 222 =cut