7 use Scalar::Util 'blessed';
9 use Sub::Name 'subname';
14 our $VERSION = '0.07';
15 our $AUTHORITY = 'cpan:STEVAN';
19 use Moose::Meta::Role;
20 use Moose::Util::TypeConstraints;
23 my ( $CALLER, %METAS );
28 return $METAS{$role} if exists $METAS{$role};
30 # make a subtype for each Moose class
33 => where { $_->does($role) }
34 => optimize_as { blessed($_[0]) && $_[0]->can('does') && $_[0]->does($role) }
35 unless find_type_constraint($role);
38 if ($role->can('meta')) {
39 $meta = $role->meta();
40 (blessed($meta) && $meta->isa('Moose::Meta::Role'))
41 || confess "You already have a &meta function, but it does not return a Moose::Meta::Role";
44 $meta = Moose::Meta::Role->initialize($role);
45 $meta->alias_method('meta' => sub { $meta });
48 return $METAS{$role} = $meta;
54 my $meta = _find_meta();
55 return subname 'Moose::Role::extends' => sub {
56 confess "Moose::Role does not currently support 'extends'"
60 my $meta = _find_meta();
61 return subname 'Moose::Role::with' => sub (@) {
63 confess "Must specify at least one role" unless @args;
65 my $roles = Data::OptList::mkopt(\@args);
70 Class::MOP::load_class($_->[0]) for @$roles;
72 ($_->[0]->can('meta') && $_->[0]->meta->isa('Moose::Meta::Role'))
73 || confess "You can only consume roles, " . $_->[0] . " is not a Moose role"
76 if (scalar @$roles == 1) {
77 my ($role, $params) = @{$roles->[0]};
78 $role->meta->apply($meta, (defined $params ? %$params : ()));
81 Moose::Meta::Role->combine(
82 map { $_->[0]->meta } @$roles
88 my $meta = _find_meta();
89 return subname 'Moose::Role::requires' => sub (@) {
90 confess "Must specify at least one method" unless @_;
91 $meta->add_required_methods(@_);
95 my $meta = _find_meta();
96 return subname 'Moose::Role::excludes' => sub (@) {
97 confess "Must specify at least one role" unless @_;
98 $meta->add_excluded_roles(@_);
102 my $meta = _find_meta();
103 return subname 'Moose::Role::has' => sub ($;%) {
104 my ($name, %options) = @_;
105 $meta->add_attribute($name, %options)
109 my $meta = _find_meta();
110 return subname 'Moose::Role::before' => sub (@&) {
112 $meta->add_before_method_modifier($_, $code) for @_;
116 my $meta = _find_meta();
117 return subname 'Moose::Role::after' => sub (@&) {
119 $meta->add_after_method_modifier($_, $code) for @_;
123 my $meta = _find_meta();
124 return subname 'Moose::Role::around' => sub (@&) {
126 $meta->add_around_method_modifier($_, $code) for @_;
132 $Moose::SUPER_SLOT{$CALLER} = \*{"${CALLER}::super"};
134 my $meta = _find_meta();
135 return subname 'Moose::Role::super' => sub {};
138 my $meta = _find_meta();
139 return subname 'Moose::Role::override' => sub ($&) {
140 my ($name, $code) = @_;
141 $meta->add_override_method_modifier($name, $code);
145 my $meta = _find_meta();
146 return subname 'Moose::Role::inner' => sub {
147 confess "Moose::Role cannot support 'inner'";
151 my $meta = _find_meta();
152 return subname 'Moose::Role::augment' => sub {
153 confess "Moose::Role cannot support 'augment'";
157 return \&Carp::confess;
160 return \&Scalar::Util::blessed;
164 my $exporter = Sub::Exporter::build_exporter({
165 exports => \%exports,
173 ref $_[1] && defined $_[1]->{into} ? $_[1]->{into}
175 && defined $_[1]->{into_level} ? caller( $_[1]->{into_level} )
182 # we should never export to main
183 return if $CALLER eq 'main';
198 Moose::Role - The Moose Role
203 use Moose::Role; # automatically turns on strict and warnings
208 my ($self, $other) = @_;
209 !$self->equal($other);
212 # ... then in your classes
215 use Moose; # automatically turns on strict and warnings
220 my ($self, $other) = @_;
221 $self->as_float == $other->as_float;
226 Role support in Moose is pretty solid at this point. However, the best
227 documentation is still the the test suite. It is fairly safe to assume Perl 6
228 style behavior and then either refer to the test suite, or ask questions on
229 #moose if something doesn't quite do what you expect.
231 We are planning writing some more documentation in the near future, but nothing
234 =head1 EXPORTED FUNCTIONS
236 Moose::Role currently supports all of the functions that L<Moose> exports, but
237 differs slightly in how some items are handled (see L<CAVEATS> below for
240 Moose::Role also offers two role-specific keyword exports:
244 =item B<requires (@method_names)>
246 Roles can require that certain methods are implemented by any class which
249 =item B<excludes (@role_names)>
251 Roles can C<exclude> other roles, in effect saying "I can never be combined
252 with these C<@role_names>". This is a feature which should not be used
259 Role support has only a few caveats:
265 Roles cannot use the C<extends> keyword; it will throw an exception for now.
266 The same is true of the C<augment> and C<inner> keywords (not sure those
267 really make sense for roles). All other Moose keywords will be I<deferred>
268 so that they can be applied to the consuming class.
272 Role composition does its best to B<not> be order-sensitive when it comes to
273 conflict resolution and requirements detection. However, it is order-sensitive
274 when it comes to method modifiers. All before/around/after modifiers are
275 included whenever a role is composed into a class, and then applied in the order
276 in which the roles are used. This also means that there is no conflict for
277 before/around/after modifiers.
279 In most cases, this will be a non-issue; however, it is something to keep in
280 mind when using method modifiers in a role. You should never assume any
285 The C<requires> keyword currently only works with actual methods. A method
286 modifier (before/around/after and override) will not count as a fufillment
287 of the requirement, and neither will an autogenerated accessor for an attribute.
289 It is likely that attribute accessors will eventually be allowed to fufill those
290 requirements, or we will introduce a C<requires_attr> keyword of some kind
291 instead. This decision has not yet been finalized.
297 All complex software has bugs lurking in it, and this module is no
298 exception. If you find a bug please either email me, or add the bug
303 Stevan Little E<lt>stevan@iinteractive.comE<gt>
305 Christian Hansen E<lt>chansen@cpan.orgE<gt>
307 =head1 COPYRIGHT AND LICENSE
309 Copyright 2006-2008 by Infinity Interactive, Inc.
311 L<http://www.iinteractive.com>
313 This library is free software; you can redistribute it and/or modify
314 it under the same terms as Perl itself.