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