todo test for metarole compat when metaroles have application metaroles
[gitmo/Moose.git] / lib / Moose / Role.pm
CommitLineData
e185c027 1package Moose::Role;
d1e17c7f 2use strict;
3use warnings;
e185c027 4
e65dccbc 5use Scalar::Util 'blessed';
f4f808de 6use Carp 'croak';
e185c027 7
2d562421 8use Sub::Exporter;
9
efa728b4 10our $VERSION = '1.15';
e606ae5f 11$VERSION = eval $VERSION;
d44714be 12our $AUTHORITY = 'cpan:STEVAN';
e185c027 13
d7d8a8c7 14use Moose ();
15use Moose::Util ();
e65dccbc 16
c36b393c 17use Moose::Exporter;
e185c027 18use Moose::Meta::Role;
7eaef7ad 19use Moose::Util::TypeConstraints;
e185c027 20
e606ae5f 21sub extends {
887e3bf0 22 croak "Roles do not support 'extends' (you can use 'with' to specialize a role)";
e606ae5f 23}
24
25sub with {
d5447d26 26 Moose::Util::apply_all_roles( shift, @_ );
e606ae5f 27}
28
29sub requires {
d5447d26 30 my $meta = shift;
e606ae5f 31 croak "Must specify at least one method" unless @_;
32 $meta->add_required_methods(@_);
33}
34
35sub excludes {
d5447d26 36 my $meta = shift;
e606ae5f 37 croak "Must specify at least one role" unless @_;
38 $meta->add_excluded_roles(@_);
39}
2d562421 40
e606ae5f 41sub has {
d5447d26 42 my $meta = shift;
e606ae5f 43 my $name = shift;
44 croak 'Usage: has \'name\' => ( key => value, ... )' if @_ == 1;
833b56a7 45 my %options = ( definition_context => Moose::Util::_caller_info(), @_ );
e606ae5f 46 my $attrs = ( ref($name) eq 'ARRAY' ) ? $name : [ ($name) ];
47 $meta->add_attribute( $_, %options ) for @$attrs;
48}
2d562421 49
2e3c7aa0 50sub _add_method_modifier {
51 my $type = shift;
d5447d26 52 my $meta = shift;
e606ae5f 53 my $code = pop @_;
fb1e11d5 54
e606ae5f 55 for (@_) {
b8945921 56 croak "Roles do not currently support "
e606ae5f 57 . ref($_)
2e3c7aa0 58 . " references for $type method modifiers"
e606ae5f 59 if ref $_;
2e3c7aa0 60 my $add_method = "add_${type}_method_modifier";
61 $meta->$add_method( $_, $code );
e606ae5f 62 }
63}
2d562421 64
2e3c7aa0 65sub before { _add_method_modifier('before', @_) }
2d562421 66
2e3c7aa0 67sub after { _add_method_modifier('after', @_) }
fb1e11d5 68
2e3c7aa0 69sub around { _add_method_modifier('around', @_) }
fb1e11d5 70
e606ae5f 71# see Moose.pm for discussion
72sub super {
73 return unless $Moose::SUPER_BODY;
74 $Moose::SUPER_BODY->(@Moose::SUPER_ARGS);
75}
76
77sub override {
d5447d26 78 my $meta = shift;
e606ae5f 79 my ( $name, $code ) = @_;
80 $meta->add_override_method_modifier( $name, $code );
81}
82
83sub inner {
b8945921 84 croak "Roles cannot support 'inner'";
e606ae5f 85}
86
87sub augment {
b8945921 88 croak "Roles cannot support 'augment'";
e606ae5f 89}
90
c36b393c 91Moose::Exporter->setup_import_methods(
d5447d26 92 with_meta => [
d4783454 93 qw( with requires excludes has before after around override )
e606ae5f 94 ],
95 as_is => [
96 qw( extends super inner augment ),
97 \&Carp::confess,
98 \&Scalar::Util::blessed,
99 ],
100);
101
102sub init_meta {
103 shift;
104 my %args = @_;
105
70ea9161 106 my $role = $args{for_class};
107
108 unless ($role) {
109 require Moose;
110 Moose->throw_error("Cannot call init_meta without specifying a for_class");
111 }
e606ae5f 112
113 my $metaclass = $args{metaclass} || "Moose::Meta::Role";
2937ed18 114 my $meta_name = exists $args{meta_name} ? $args{meta_name} : 'meta';
e606ae5f 115
ed544690 116 Moose->throw_error("The Metaclass $metaclass must be a subclass of Moose::Meta::Role.")
117 unless $metaclass->isa('Moose::Meta::Role');
118
119 # make a subtype for each Moose role
e606ae5f 120 role_type $role unless find_type_constraint($role);
121
e606ae5f 122 my $meta;
ed544690 123 if ( $meta = Class::MOP::get_metaclass_by_name($role) ) {
124 unless ( $meta->isa("Moose::Meta::Role") ) {
125 my $error_message = "$role already has a metaclass, but it does not inherit $metaclass ($meta).";
126 if ( $meta->isa('Moose::Meta::Class') ) {
127 Moose->throw_error($error_message . ' You cannot make the same thing a role and a class. Remove either Moose or Moose::Role.');
128 } else {
129 Moose->throw_error($error_message);
130 }
70ea9161 131 }
e606ae5f 132 }
133 else {
134 $meta = $metaclass->initialize($role);
ed544690 135 }
e606ae5f 136
2937ed18 137 if (defined $meta_name) {
ed544690 138 # also check for inherited non moose 'meta' method?
2937ed18 139 my $existing = $meta->get_method($meta_name);
d65bfd76 140 if ($existing && !$existing->isa('Class::MOP::Method::Meta')) {
df100ac2 141 Carp::cluck "Moose::Role is overwriting an existing method named "
2937ed18 142 . "$meta_name in role $role with a method "
143 . "which returns the class's metaclass. If this is "
144 . "actually what you want, you should remove the "
145 . "existing method, otherwise, you should rename or "
146 . "disable this generated method using the "
147 . "'-meta_name' option to 'use Moose::Role'.";
d65bfd76 148 }
2937ed18 149 $meta->_add_meta_method($meta_name);
d31f9614 150 }
e606ae5f 151
152 return $meta;
e185c027 153}
154
1551;
156
157__END__
158
159=pod
160
161=head1 NAME
162
163Moose::Role - The Moose Role
164
76d37e5a 165=head1 SYNOPSIS
166
167 package Eq;
85424612 168 use Moose::Role; # automatically turns on strict and warnings
fb1e11d5 169
e46edf94 170 requires 'equal';
fb1e11d5 171
172 sub no_equal {
76d37e5a 173 my ($self, $other) = @_;
174 !$self->equal($other);
175 }
fb1e11d5 176
76d37e5a 177 # ... then in your classes
fb1e11d5 178
76d37e5a 179 package Currency;
85424612 180 use Moose; # automatically turns on strict and warnings
fb1e11d5 181
76d37e5a 182 with 'Eq';
fb1e11d5 183
76d37e5a 184 sub equal {
185 my ($self, $other) = @_;
bdabd620 186 $self->as_float == $other->as_float;
76d37e5a 187 }
188
e185c027 189=head1 DESCRIPTION
190
46b73973 191The concept of roles is documented in L<Moose::Manual::Roles>. This document
69161799 192serves as API documentation.
76d37e5a 193
2c0cbef7 194=head1 EXPORTED FUNCTIONS
195
85424612 196Moose::Role currently supports all of the functions that L<Moose> exports, but
cec39889 197differs slightly in how some items are handled (see L</CAVEATS> below for
85424612 198details).
76d37e5a 199
85424612 200Moose::Role also offers two role-specific keyword exports:
e185c027 201
202=over 4
203
2c0cbef7 204=item B<requires (@method_names)>
76d37e5a 205
fb1e11d5 206Roles can require that certain methods are implemented by any class which
85424612 207C<does> the role.
9e93dd19 208
92fcea04 209Note that attribute accessors also count as methods for the purposes
210of satisfying the requirements of a role.
211
2c0cbef7 212=item B<excludes (@role_names)>
213
9e93dd19 214Roles can C<exclude> other roles, in effect saying "I can never be combined
fb1e11d5 215with these C<@role_names>". This is a feature which should not be used
85424612 216lightly.
9e93dd19 217
2c0cbef7 218=back
219
d31f9614 220=head2 B<unimport>
221
222Moose::Role offers a way to remove the keywords it exports, through the
223C<unimport> method. You simply have to say C<no Moose::Role> at the bottom of
224your code for this to work.
225
e606ae5f 226=head2 B<< Moose::Role->init_meta(for_class => $role, metaclass => $metaclass) >>
227
228The C<init_meta> method sets up the metaclass object for the role
229specified by C<for_class>. It also injects a a C<meta> accessor into
230the role so you can get at this object.
231
232The default metaclass is L<Moose::Meta::Role>. You can specify an
233alternate metaclass with the C<metaclass> parameter.
234
c1381000 235=head1 METACLASS
236
237When you use Moose::Role, you can specify which metaclass to use:
238
239 use Moose::Role -metaclass => 'My::Meta::Role';
240
241You can also specify traits which will be applied to your role metaclass:
242
243 use Moose::Role -traits => 'My::Trait';
244
245This is very similar to the attribute traits feature. When you do
246this, your class's C<meta> object will have the specified traits
8a8856de 247applied to it. See L<Moose/Metaclass and Trait Name Resolution> for more
248details.
c1381000 249
b9cb323b 250=head1 APPLYING ROLES
251
252In addition to being applied to a class using the 'with' syntax (see
253L<Moose::Manual::Roles>) and using the L<Moose::Util> 'apply_all_roles'
254method, roles may also be applied to an instance of a class using
255L<Moose::Util> 'apply_all_roles' or the role's metaclass:
256
257 MyApp::Test::SomeRole->meta->apply( $instance );
258
259Doing this creates a new, mutable, anonymous subclass, applies the role to that,
260and reblesses. In a debugger, for example, you will see class names of the
261form C< Class::MOP::Class::__ANON__::SERIAL::6 >, which means that doing a 'ref'
262on your instance may not return what you expect. See L<Moose::Object> for 'DOES'.
263
264Additional params may be added to the new instance by providing 'rebless_params'.
265See L<Moose::Meta::Role::Application::ToInstance>.
266
2c0cbef7 267=head1 CAVEATS
268
85424612 269Role support has only a few caveats:
2c0cbef7 270
271=over 4
76d37e5a 272
76d37e5a 273=item *
274
fb1e11d5 275Roles cannot use the C<extends> keyword; it will throw an exception for now.
276The same is true of the C<augment> and C<inner> keywords (not sure those
277really make sense for roles). All other Moose keywords will be I<deferred>
85424612 278so that they can be applied to the consuming class.
76d37e5a 279
fb1e11d5 280=item *
2c0cbef7 281
85424612 282Role composition does its best to B<not> be order-sensitive when it comes to
283conflict resolution and requirements detection. However, it is order-sensitive
284when it comes to method modifiers. All before/around/after modifiers are
285included whenever a role is composed into a class, and then applied in the order
286in which the roles are used. This also means that there is no conflict for
287before/around/after modifiers.
2c0cbef7 288
85424612 289In most cases, this will be a non-issue; however, it is something to keep in
290mind when using method modifiers in a role. You should never assume any
2c0cbef7 291ordering.
292
e185c027 293=back
294
295=head1 BUGS
296
d4048ef3 297See L<Moose/BUGS> for details on reporting bugs.
e185c027 298
299=head1 AUTHOR
300
301Stevan Little E<lt>stevan@iinteractive.comE<gt>
302
db1ab48d 303Christian Hansen E<lt>chansen@cpan.orgE<gt>
98aae381 304
e185c027 305=head1 COPYRIGHT AND LICENSE
306
7e0492d3 307Copyright 2006-2010 by Infinity Interactive, Inc.
e185c027 308
309L<http://www.iinteractive.com>
310
311This library is free software; you can redistribute it and/or modify
fb1e11d5 312it under the same terms as Perl itself.
e185c027 313
68117c45 314=cut