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.89_01';
  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  => 'get_method_map',
  30     default => sub { {} }
  31 ));
  32
  33 sub new {
  34     my ($class, %params) = @_;
  35     # the roles param is required ...
  36     foreach ( @{$params{roles}} ) {
  37         unless ( $_->isa('Moose::Meta::Role') ) {
  38             require Moose;
  39             Moose->throw_error("The list of roles must be instances of Moose::Meta::Role, not $_");
  40         }
  41     }
  42     # and the name is created from the
  43     # roles if one has not been provided
  44     $params{name} ||= (join "|" => map { $_->name } @{$params{roles}});
  45     $class->_new(\%params);
  46 }
  47
  48 # This is largely a cope of what's in Moose::Meta::Role (itself
  49 # largely a copy of Class::MOP::Class). However, we can't actually
  50 # call add_package_symbol, because there's no package to which which
  51 # add the symbol.
  52 sub add_method {
  53     my ($self, $method_name, $method) = @_;
  54
  55     unless ( defined $method_name && $method_name ) {
  56         Moose->throw_error("You must define a method name");
  57     }
  58
  59     my $body;
  60     if (blessed($method)) {
  61         $body = $method->body;
  62         if ($method->package_name ne $self->name) {
  63             $method = $method->clone(
  64                 package_name => $self->name,
  65                 name         => $method_name
  66             ) if $method->can('clone');
  67         }
  68     }
  69     else {
  70         $body = $method;
  71         $method = $self->wrap_method_body( body => $body, name => $method_name );
  72     }
  73
  74     $self->get_method_map->{$method_name} = $method;
  75 }
  76
  77 1;
  78
  79 __END__
  80
  81 =pod
  82
  83 =head1 NAME
  84
  85 Moose::Meta::Role::Composite - An object to represent the set of roles
  86
  87 =head1 DESCRIPTION
  88
  89 A composite is a role that consists of a set of two or more roles.
  90
  91 The API of a composite role is almost identical to that of a regular
  92 role.
  93
  94 =head1 INHERITANCE
  95
  96 C<Moose::Meta::Role::Composite> is a subclass of L<Moose::Meta::Role>.
  97
  98 =head2 METHODS
  99
 100 =over 4
 101
 102 =item B<< Moose::Meta::Role::Composite->new(%options) >>
 103
 104 This returns a new composite role object. It accepts the same
 105 options as its parent class, with a few changes:
 106
 107 =over 8
 108
 109 =item * roles
 110
 111 This option is an array reference containing a list of
 112 L<Moose::Meta::Role> object. This is a required option.
 113
 114 =item * name
 115
 116 If a name is not given, one is generated from the roles provided.
 117
 118 =back
 119
 120 =back
 121
 122 =head1 BUGS
 123
 124 All complex software has bugs lurking in it, and this module is no
 125 exception. If you find a bug please either email me, or add the bug
 126 to cpan-RT.
 127
 128 =head1 AUTHOR
 129
 130 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 131
 132 =head1 COPYRIGHT AND LICENSE
 133
 134 Copyright 2006-2009 by Infinity Interactive, Inc.
 135
 136 L<http://www.iinteractive.com>
 137
 138 This library is free software; you can redistribute it and/or modify
 139 it under the same terms as Perl itself.
 140
 141 =cut