docs
[gitmo/Moose.git] / lib / Moose / Role.pm
CommitLineData
e185c027 1
2package Moose::Role;
3
4use strict;
5use warnings;
6
7use Scalar::Util ();
8use Carp 'confess';
9use Sub::Name 'subname';
10
2d562421 11use Sub::Exporter;
12
2c0cbef7 13our $VERSION = '0.04';
e185c027 14
15use Moose::Meta::Role;
7eaef7ad 16use Moose::Util::TypeConstraints;
e185c027 17
2d562421 18{
19 my ( $CALLER, %METAS );
20
21 sub _find_meta {
7eaef7ad 22 my $role = $CALLER;
2d562421 23
7eaef7ad 24 return $METAS{$role} if exists $METAS{$role};
25
26 # make a subtype for each Moose class
27 subtype $role
28 => as 'Role'
29 => where { $_->does($role) }
30 unless find_type_constraint($role);
2d562421 31
32 my $meta;
7eaef7ad 33 if ($role->can('meta')) {
34 $meta = $role->meta();
2d562421 35 (blessed($meta) && $meta->isa('Moose::Meta::Role'))
36 || confess "Whoops, not møøsey enough";
37 }
38 else {
7eaef7ad 39 $meta = Moose::Meta::Role->new(role_name => $role);
2d562421 40 $meta->_role_meta->add_method('meta' => sub { $meta })
41 }
42
7eaef7ad 43 return $METAS{$role} = $meta;
2d562421 44 }
45
e185c027 46
9d3188da 47 my %exports = (
2d562421 48 extends => sub {
49 my $meta = _find_meta();
50 return subname 'Moose::Role::extends' => sub {
51 confess "Moose::Role does not currently support 'extends'"
52 };
53 },
54 with => sub {
55 my $meta = _find_meta();
2c0cbef7 56 return subname 'Moose::Role::with' => sub ($;@) {
d05cd563 57 my (@roles) = @_;
58 Moose::_load_all_classes(@roles);
59 ($_->can('meta') && $_->meta->isa('Moose::Meta::Role'))
60 || confess "You can only consume roles, $_ is not a Moose role"
61 foreach @roles;
62 if (scalar @roles == 1) {
63 $roles[0]->meta->apply($meta);
64 }
65 else {
66 Moose::Meta::Role->combine(
67 map { $_->meta } @roles
68 )->apply($meta);
69 }
2d562421 70 };
71 },
72 requires => sub {
73 my $meta = _find_meta();
2c0cbef7 74 return subname 'Moose::Role::requires' => sub ($;@) {
2d562421 75 $meta->add_required_methods(@_);
76 };
77 },
d79e62fd 78 excludes => sub {
79 my $meta = _find_meta();
2c0cbef7 80 return subname 'Moose::Role::excludes' => sub ($;@) {
d79e62fd 81 $meta->add_excluded_roles(@_);
82 };
83 },
2d562421 84 has => sub {
85 my $meta = _find_meta();
2c0cbef7 86 return subname 'Moose::Role::has' => sub ($;%) {
2d562421 87 my ($name, %options) = @_;
88 $meta->add_attribute($name, %options)
89 };
90 },
91 before => sub {
92 my $meta = _find_meta();
2c0cbef7 93 return subname 'Moose::Role::before' => sub (@&) {
2d562421 94 my $code = pop @_;
95 $meta->add_before_method_modifier($_, $code) for @_;
96 };
97 },
98 after => sub {
99 my $meta = _find_meta();
2c0cbef7 100 return subname 'Moose::Role::after' => sub (@&) {
2d562421 101 my $code = pop @_;
102 $meta->add_after_method_modifier($_, $code) for @_;
103 };
104 },
105 around => sub {
106 my $meta = _find_meta();
2c0cbef7 107 return subname 'Moose::Role::around' => sub (@&) {
2d562421 108 my $code = pop @_;
109 $meta->add_around_method_modifier($_, $code) for @_;
110 };
111 },
112 super => sub {
113 my $meta = _find_meta();
114 return subname 'Moose::Role::super' => sub {};
115 },
116 override => sub {
117 my $meta = _find_meta();
2c0cbef7 118 return subname 'Moose::Role::override' => sub ($&) {
2d562421 119 my ($name, $code) = @_;
120 $meta->add_override_method_modifier($name, $code);
121 };
122 },
123 inner => sub {
124 my $meta = _find_meta();
125 return subname 'Moose::Role::inner' => sub {
126 confess "Moose::Role does not currently support 'inner'";
127 };
128 },
129 augment => sub {
130 my $meta = _find_meta();
131 return subname 'Moose::Role::augment' => sub {
132 confess "Moose::Role does not currently support 'augment'";
133 };
134 },
135 confess => sub {
136 return \&Carp::confess;
137 },
138 blessed => sub {
139 return \&Scalar::Util::blessed;
140 }
141 );
142
143 my $exporter = Sub::Exporter::build_exporter({
144 exports => \%exports,
145 groups => {
146 default => [':all']
147 }
148 });
149
150 sub import {
151 $CALLER = caller();
152
153 # we should never export to main
154 return if $CALLER eq 'main';
155
156 goto $exporter;
157 };
158
e185c027 159}
160
1611;
162
163__END__
164
165=pod
166
167=head1 NAME
168
169Moose::Role - The Moose Role
170
76d37e5a 171=head1 SYNOPSIS
172
173 package Eq;
174 use strict;
175 use warnings;
176 use Moose::Role;
177
e46edf94 178 requires 'equal';
76d37e5a 179
180 sub no_equal {
181 my ($self, $other) = @_;
182 !$self->equal($other);
183 }
184
185 # ... then in your classes
186
187 package Currency;
188 use strict;
189 use warnings;
190 use Moose;
191
192 with 'Eq';
193
194 sub equal {
195 my ($self, $other) = @_;
bdabd620 196 $self->as_float == $other->as_float;
76d37e5a 197 }
198
e185c027 199=head1 DESCRIPTION
200
2c0cbef7 201Role support in Moose is coming along quite well. It's best documentation
202is still the the test suite, but it is fairly safe to assume Perl 6 style
203behavior, and then either refer to the test suite, or ask questions on
204#moose if something doesn't quite do what you expect. More complete
205documentation is planned and will be included with the next official
206(non-developer) release.
76d37e5a 207
2c0cbef7 208=head1 EXPORTED FUNCTIONS
209
210Currently Moose::Role supports all of the functions that L<Moose> exports,
211but differs slightly in how some items are handled (see L<CAVEATS> below
212for details).
76d37e5a 213
2c0cbef7 214Moose::Role also offers two role specific keyword exports:
e185c027 215
216=over 4
217
2c0cbef7 218=item B<requires (@method_names)>
76d37e5a 219
2c0cbef7 220=item B<excludes (@role_names)>
221
222=back
223
224=head1 CAVEATS
225
226The role support now has only a few caveats. They are as follows:
227
228=over 4
76d37e5a 229
76d37e5a 230=item *
231
232Roles cannot use the C<extends> keyword, it will throw an exception for now.
233The same is true of the C<augment> and C<inner> keywords (not sure those
234really make sense for roles). All other Moose keywords will be I<deferred>
235so that they can be applied to the consuming class.
236
2c0cbef7 237=item *
238
239Role composition does it's best to B<not> be order sensitive when it comes
240to conflict resolution and requirements detection. However, it is order
241sensitive when it comes to method modifiers. All before/around/after modifiers
242are included whenever a role is composed into a class, and then are applied
243in the order the roles are used. This too means that there is no conflict for
244before/around/after modifiers as well.
245
246In most cases, this will be a non issue, however it is something to keep in
247mind when using method modifiers in a role. You should never assume any
248ordering.
249
250=item *
251
252The C<requires> keyword currently only works with actual methods. A method
253modifier (before/around/after and override) will not count as a fufillment
254of the requirement, and neither will an autogenerated accessor for an attribute.
255
256It is likely that the attribute accessors will eventually be allowed to fufill
257those requirements, either that or we will introduce a C<requires_attr> keyword
258of some kind instead. This descision has not yet been finalized.
259
e185c027 260=back
261
262=head1 BUGS
263
264All complex software has bugs lurking in it, and this module is no
265exception. If you find a bug please either email me, or add the bug
266to cpan-RT.
267
268=head1 AUTHOR
269
270Stevan Little E<lt>stevan@iinteractive.comE<gt>
271
db1ab48d 272Christian Hansen E<lt>chansen@cpan.orgE<gt>
98aae381 273
e185c027 274=head1 COPYRIGHT AND LICENSE
275
276Copyright 2006 by Infinity Interactive, Inc.
277
278L<http://www.iinteractive.com>
279
280This library is free software; you can redistribute it and/or modify
281it under the same terms as Perl itself.
282
283=cut