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