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.64';
  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     ($_->isa('Moose::Meta::Role'))
  37         || Moose->throw_error("The list of roles must be instances of Moose::Meta::Role, not $_")
  38             foreach @{$params{roles}};
  39     # and the name is created from the
  40     # roles if one has not been provided
  41     $params{name} ||= (join "|" => map { $_->name } @{$params{roles}});
  42     $class->_new(\%params);
  43 }
  44
  45 # This is largely a cope of what's in Moose::Meta::Role (itself
  46 # largely a copy of Class::MOP::Class). However, we can't actually
  47 # call add_package_symbol, because there's no package to which which
  48 # add the symbol.
  49 sub add_method {
  50     my ($self, $method_name, $method) = @_;
  51     (defined $method_name && $method_name)
  52     || Moose->throw_error("You must define a method name");
  53
  54     my $body;
  55     if (blessed($method)) {
  56         $body = $method->body;
  57         if ($method->package_name ne $self->name) {
  58             $method = $method->clone(
  59                 package_name => $self->name,
  60                 name         => $method_name
  61             ) if $method->can('clone');
  62         }
  63     }
  64     else {
  65         $body = $method;
  66         $method = $self->wrap_method_body( body => $body, name => $method_name );
  67     }
  68
  69     $self->get_method_map->{$method_name} = $method;
  70 }
  71
  72 1;
  73
  74 __END__
  75
  76 =pod
  77
  78 =head1 NAME
  79
  80 Moose::Meta::Role::Composite - An object to represent the set of roles
  81
  82 =head1 DESCRIPTION
  83
  84 =head2 METHODS
  85
  86 =over 4
  87
  88 =item B<new>
  89
  90 =item B<meta>
  91
  92 =item B<name>
  93
  94 =item B<get_method_map>
  95
  96 =item B<add_method>
  97
  98 =back
  99
 100 =head1 BUGS
 101
 102 All complex software has bugs lurking in it, and this module is no
 103 exception. If you find a bug please either email me, or add the bug
 104 to cpan-RT.
 105
 106 =head1 AUTHOR
 107
 108 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 109
 110 =head1 COPYRIGHT AND LICENSE
 111
 112 Copyright 2006-2008 by Infinity Interactive, Inc.
 113
 114 L<http://www.iinteractive.com>
 115
 116 This library is free software; you can redistribute it and/or modify
 117 it under the same terms as Perl itself.
 118
 119 =cut