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.71_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 =head2 METHODS
  90
  91 =over 4
  92
  93 =item B<new>
  94
  95 =item B<meta>
  96
  97 =item B<name>
  98
  99 =item B<get_method_map>
 100
 101 =item B<add_method>
 102
 103 =back
 104
 105 =head1 BUGS
 106
 107 All complex software has bugs lurking in it, and this module is no
 108 exception. If you find a bug please either email me, or add the bug
 109 to cpan-RT.
 110
 111 =head1 AUTHOR
 112
 113 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 114
 115 =head1 COPYRIGHT AND LICENSE
 116
 117 Copyright 2006-2009 by Infinity Interactive, Inc.
 118
 119 L<http://www.iinteractive.com>
 120
 121 This library is free software; you can redistribute it and/or modify
 122 it under the same terms as Perl itself.
 123
 124 =cut