these todo tests work now, with cmop fixes
[gitmo/Moose.git] / lib / Moose / Role.pm
CommitLineData
e185c027 1
2package Moose::Role;
3
e65dccbc 4use Scalar::Util 'blessed';
f4f808de 5use Carp 'croak';
e185c027 6
2d562421 7use Sub::Exporter;
8
e3d94ac0 9our $VERSION = '0.82';
e606ae5f 10$VERSION = eval $VERSION;
d44714be 11our $AUTHORITY = 'cpan:STEVAN';
e185c027 12
d7d8a8c7 13use Moose ();
14use Moose::Util ();
e65dccbc 15
c36b393c 16use Moose::Exporter;
e185c027 17use Moose::Meta::Role;
7eaef7ad 18use Moose::Util::TypeConstraints;
e185c027 19
e606ae5f 20sub extends {
887e3bf0 21 croak "Roles do not support 'extends' (you can use 'with' to specialize a role)";
e606ae5f 22}
23
24sub with {
25 Moose::Util::apply_all_roles( Moose::Meta::Role->initialize(shift), @_ );
26}
27
28sub requires {
29 my $meta = Moose::Meta::Role->initialize(shift);
30 croak "Must specify at least one method" unless @_;
31 $meta->add_required_methods(@_);
32}
33
34sub excludes {
35 my $meta = Moose::Meta::Role->initialize(shift);
36 croak "Must specify at least one role" unless @_;
37 $meta->add_excluded_roles(@_);
38}
2d562421 39
e606ae5f 40sub has {
41 my $meta = Moose::Meta::Role->initialize(shift);
42 my $name = shift;
43 croak 'Usage: has \'name\' => ( key => value, ... )' if @_ == 1;
44 my %options = @_;
45 my $attrs = ( ref($name) eq 'ARRAY' ) ? $name : [ ($name) ];
46 $meta->add_attribute( $_, %options ) for @$attrs;
47}
2d562421 48
2e3c7aa0 49sub _add_method_modifier {
50 my $type = shift;
e606ae5f 51 my $meta = Moose::Meta::Role->initialize(shift);
52 my $code = pop @_;
fb1e11d5 53
e606ae5f 54 for (@_) {
b8945921 55 croak "Roles do not currently support "
e606ae5f 56 . ref($_)
2e3c7aa0 57 . " references for $type method modifiers"
e606ae5f 58 if ref $_;
2e3c7aa0 59 my $add_method = "add_${type}_method_modifier";
60 $meta->$add_method( $_, $code );
e606ae5f 61 }
62}
2d562421 63
2e3c7aa0 64sub before { _add_method_modifier('before', @_) }
2d562421 65
2e3c7aa0 66sub after { _add_method_modifier('after', @_) }
fb1e11d5 67
2e3c7aa0 68sub around { _add_method_modifier('around', @_) }
fb1e11d5 69
e606ae5f 70# see Moose.pm for discussion
71sub super {
72 return unless $Moose::SUPER_BODY;
73 $Moose::SUPER_BODY->(@Moose::SUPER_ARGS);
74}
75
76sub override {
77 my $meta = Moose::Meta::Role->initialize(shift);
78 my ( $name, $code ) = @_;
79 $meta->add_override_method_modifier( $name, $code );
80}
81
82sub inner {
b8945921 83 croak "Roles cannot support 'inner'";
e606ae5f 84}
85
86sub augment {
b8945921 87 croak "Roles cannot support 'augment'";
e606ae5f 88}
89
c36b393c 90Moose::Exporter->setup_import_methods(
e606ae5f 91 with_caller => [
92 qw( with requires excludes has before after around override make_immutable )
93 ],
94 as_is => [
95 qw( extends super inner augment ),
96 \&Carp::confess,
97 \&Scalar::Util::blessed,
98 ],
99);
100
101sub init_meta {
102 shift;
103 my %args = @_;
104
70ea9161 105 my $role = $args{for_class};
106
107 unless ($role) {
108 require Moose;
109 Moose->throw_error("Cannot call init_meta without specifying a for_class");
110 }
e606ae5f 111
112 my $metaclass = $args{metaclass} || "Moose::Meta::Role";
113
114 # make a subtype for each Moose class
115 role_type $role unless find_type_constraint($role);
116
117 # FIXME copy from Moose.pm
118 my $meta;
119 if ($role->can('meta')) {
120 $meta = $role->meta();
70ea9161 121
122 unless ( blessed($meta) && $meta->isa('Moose::Meta::Role') ) {
123 require Moose;
124 Moose->throw_error("You already have a &meta function, but it does not return a Moose::Meta::Role");
125 }
e606ae5f 126 }
127 else {
128 $meta = $metaclass->initialize($role);
129
130 $meta->add_method(
131 'meta' => sub {
132 # re-initialize so it inherits properly
133 $metaclass->initialize( ref($_[0]) || $_[0] );
d31f9614 134 }
e606ae5f 135 );
d31f9614 136 }
e606ae5f 137
138 return $meta;
e185c027 139}
140
1411;
142
143__END__
144
145=pod
146
147=head1 NAME
148
149Moose::Role - The Moose Role
150
76d37e5a 151=head1 SYNOPSIS
152
153 package Eq;
85424612 154 use Moose::Role; # automatically turns on strict and warnings
fb1e11d5 155
e46edf94 156 requires 'equal';
fb1e11d5 157
158 sub no_equal {
76d37e5a 159 my ($self, $other) = @_;
160 !$self->equal($other);
161 }
fb1e11d5 162
76d37e5a 163 # ... then in your classes
fb1e11d5 164
76d37e5a 165 package Currency;
85424612 166 use Moose; # automatically turns on strict and warnings
fb1e11d5 167
76d37e5a 168 with 'Eq';
fb1e11d5 169
76d37e5a 170 sub equal {
171 my ($self, $other) = @_;
bdabd620 172 $self->as_float == $other->as_float;
76d37e5a 173 }
174
e185c027 175=head1 DESCRIPTION
176
69161799 177The concept of roles is documented in L<Moose::Manual::Role>. This document
178serves as API documentation.
76d37e5a 179
2c0cbef7 180=head1 EXPORTED FUNCTIONS
181
85424612 182Moose::Role currently supports all of the functions that L<Moose> exports, but
183differs slightly in how some items are handled (see L<CAVEATS> below for
184details).
76d37e5a 185
85424612 186Moose::Role also offers two role-specific keyword exports:
e185c027 187
188=over 4
189
2c0cbef7 190=item B<requires (@method_names)>
76d37e5a 191
fb1e11d5 192Roles can require that certain methods are implemented by any class which
85424612 193C<does> the role.
9e93dd19 194
2c0cbef7 195=item B<excludes (@role_names)>
196
9e93dd19 197Roles can C<exclude> other roles, in effect saying "I can never be combined
fb1e11d5 198with these C<@role_names>". This is a feature which should not be used
85424612 199lightly.
9e93dd19 200
2c0cbef7 201=back
202
d31f9614 203=head2 B<unimport>
204
205Moose::Role offers a way to remove the keywords it exports, through the
206C<unimport> method. You simply have to say C<no Moose::Role> at the bottom of
207your code for this to work.
208
e606ae5f 209=head2 B<< Moose::Role->init_meta(for_class => $role, metaclass => $metaclass) >>
210
211The C<init_meta> method sets up the metaclass object for the role
212specified by C<for_class>. It also injects a a C<meta> accessor into
213the role so you can get at this object.
214
215The default metaclass is L<Moose::Meta::Role>. You can specify an
216alternate metaclass with the C<metaclass> parameter.
217
c1381000 218=head1 METACLASS
219
220When you use Moose::Role, you can specify which metaclass to use:
221
222 use Moose::Role -metaclass => 'My::Meta::Role';
223
224You can also specify traits which will be applied to your role metaclass:
225
226 use Moose::Role -traits => 'My::Trait';
227
228This is very similar to the attribute traits feature. When you do
229this, your class's C<meta> object will have the specified traits
230applied to it. See L<Moose/TRAIT NAME RESOLUTION> for more details.
231
2c0cbef7 232=head1 CAVEATS
233
85424612 234Role support has only a few caveats:
2c0cbef7 235
236=over 4
76d37e5a 237
76d37e5a 238=item *
239
fb1e11d5 240Roles cannot use the C<extends> keyword; it will throw an exception for now.
241The same is true of the C<augment> and C<inner> keywords (not sure those
242really make sense for roles). All other Moose keywords will be I<deferred>
85424612 243so that they can be applied to the consuming class.
76d37e5a 244
fb1e11d5 245=item *
2c0cbef7 246
85424612 247Role composition does its best to B<not> be order-sensitive when it comes to
248conflict resolution and requirements detection. However, it is order-sensitive
249when it comes to method modifiers. All before/around/after modifiers are
250included whenever a role is composed into a class, and then applied in the order
251in which the roles are used. This also means that there is no conflict for
252before/around/after modifiers.
2c0cbef7 253
85424612 254In most cases, this will be a non-issue; however, it is something to keep in
255mind when using method modifiers in a role. You should never assume any
2c0cbef7 256ordering.
257
e185c027 258=back
259
260=head1 BUGS
261
fb1e11d5 262All complex software has bugs lurking in it, and this module is no
e185c027 263exception. If you find a bug please either email me, or add the bug
264to cpan-RT.
265
266=head1 AUTHOR
267
268Stevan Little E<lt>stevan@iinteractive.comE<gt>
269
db1ab48d 270Christian Hansen E<lt>chansen@cpan.orgE<gt>
98aae381 271
e185c027 272=head1 COPYRIGHT AND LICENSE
273
2840a3b2 274Copyright 2006-2009 by Infinity Interactive, Inc.
e185c027 275
276L<http://www.iinteractive.com>
277
278This library is free software; you can redistribute it and/or modify
fb1e11d5 279it under the same terms as Perl itself.
e185c027 280
68117c45 281=cut