7 use Scalar::Util 'blessed';
8 use Carp 'confess', 'croak';
13 our $VERSION = '0.50';
14 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
31 role_type $role unless find_type_constraint($role);
34 if ($role->can('meta')) {
35 $meta = $role->meta();
36 (blessed($meta) && $meta->isa('Moose::Meta::Role'))
37 || confess "You already have a &meta function, but it does not return a Moose::Meta::Role";
40 $meta = Moose::Meta::Role->initialize($role);
41 $meta->alias_method('meta' => sub { $meta });
44 return $METAS{$role} = $meta;
50 my $meta = _find_meta();
51 return Class::MOP::subname('Moose::Role::extends' => sub {
52 croak "Roles do not currently support 'extends'"
56 my $meta = _find_meta();
57 return Class::MOP::subname('Moose::Role::with' => sub (@) {
58 Moose::Util::apply_all_roles($meta, @_)
62 my $meta = _find_meta();
63 return Class::MOP::subname('Moose::Role::requires' => sub (@) {
64 croak "Must specify at least one method" unless @_;
65 $meta->add_required_methods(@_);
69 my $meta = _find_meta();
70 return Class::MOP::subname('Moose::Role::excludes' => sub (@) {
71 croak "Must specify at least one role" unless @_;
72 $meta->add_excluded_roles(@_);
76 my $meta = _find_meta();
77 return Class::MOP::subname('Moose::Role::has' => sub ($;%) {
79 croak 'Usage: has \'name\' => ( key => value, ... )' if @_ == 1;
81 my $attrs = ( ref($name) eq 'ARRAY' ) ? $name : [ ($name) ];
82 $meta->add_attribute( $_, %options ) for @$attrs;
86 my $meta = _find_meta();
87 return Class::MOP::subname('Moose::Role::before' => sub (@&) {
90 croak "Moose::Role do not currently support "
92 . " references for before method modifiers"
94 $meta->add_before_method_modifier($_, $code)
99 my $meta = _find_meta();
100 return Class::MOP::subname('Moose::Role::after' => sub (@&) {
103 croak "Moose::Role do not currently support "
105 . " references for after method modifiers"
107 $meta->add_after_method_modifier($_, $code)
112 my $meta = _find_meta();
113 return Class::MOP::subname('Moose::Role::around' => sub (@&) {
116 croak "Moose::Role do not currently support "
118 . " references for around method modifiers"
120 $meta->add_around_method_modifier($_, $code)
124 # see Moose.pm for discussion
126 return Class::MOP::subname('Moose::Role::super' => sub {
127 return unless $Moose::SUPER_BODY; $Moose::SUPER_BODY->(@Moose::SUPER_ARGS)
131 my $meta = _find_meta();
132 return Class::MOP::subname('Moose::Role::override' => sub ($&) {
133 my ($name, $code) = @_;
134 $meta->add_override_method_modifier($name, $code);
138 my $meta = _find_meta();
139 return Class::MOP::subname('Moose::Role::inner' => sub {
140 croak "Moose::Role cannot support 'inner'";
144 my $meta = _find_meta();
145 return Class::MOP::subname('Moose::Role::augment' => sub {
146 croak "Moose::Role cannot support 'augment'";
150 return \&Carp::confess;
153 return \&Scalar::Util::blessed;
157 my $exporter = Sub::Exporter::build_exporter({
158 exports => \%exports,
166 ref $_[1] && defined $_[1]->{into} ? $_[1]->{into}
168 && defined $_[1]->{into_level} ? caller( $_[1]->{into_level} )
171 # this works because both pragmas set $^H (see perldoc perlvar)
172 # which affects the current compilation - i.e. the file who use'd
173 # us - which is why we don't need to do anything special to make
174 # it affect that file rather than this one (which is already compiled)
179 # we should never export to main
180 return if $CALLER eq 'main';
187 my $class = _get_caller(@_);
189 # loop through the exports ...
190 foreach my $name ( keys %exports ) {
193 if ( defined &{ $class . '::' . $name } ) {
194 my $keyword = \&{ $class . '::' . $name };
196 # make sure it is from Moose::Role
197 my ($pkg_name) = Class::MOP::get_code_info($keyword);
198 next if $pkg_name ne 'Moose::Role';
200 # and if it is from Moose::Role then undef the slot
201 delete ${ $class . '::' }{$name};
215 Moose::Role - The Moose Role
220 use Moose::Role; # automatically turns on strict and warnings
225 my ($self, $other) = @_;
226 !$self->equal($other);
229 # ... then in your classes
232 use Moose; # automatically turns on strict and warnings
237 my ($self, $other) = @_;
238 $self->as_float == $other->as_float;
243 Role support in Moose is pretty solid at this point. However, the best
244 documentation is still the the test suite. It is fairly safe to assume Perl 6
245 style behavior and then either refer to the test suite, or ask questions on
246 #moose if something doesn't quite do what you expect.
248 We are planning writing some more documentation in the near future, but nothing
251 =head1 EXPORTED FUNCTIONS
253 Moose::Role currently supports all of the functions that L<Moose> exports, but
254 differs slightly in how some items are handled (see L<CAVEATS> below for
257 Moose::Role also offers two role-specific keyword exports:
261 =item B<requires (@method_names)>
263 Roles can require that certain methods are implemented by any class which
266 =item B<excludes (@role_names)>
268 Roles can C<exclude> other roles, in effect saying "I can never be combined
269 with these C<@role_names>". This is a feature which should not be used
276 Moose::Role offers a way to remove the keywords it exports, through the
277 C<unimport> method. You simply have to say C<no Moose::Role> at the bottom of
278 your code for this to work.
282 Role support has only a few caveats:
288 Roles cannot use the C<extends> keyword; it will throw an exception for now.
289 The same is true of the C<augment> and C<inner> keywords (not sure those
290 really make sense for roles). All other Moose keywords will be I<deferred>
291 so that they can be applied to the consuming class.
295 Role composition does its best to B<not> be order-sensitive when it comes to
296 conflict resolution and requirements detection. However, it is order-sensitive
297 when it comes to method modifiers. All before/around/after modifiers are
298 included whenever a role is composed into a class, and then applied in the order
299 in which the roles are used. This also means that there is no conflict for
300 before/around/after modifiers.
302 In most cases, this will be a non-issue; however, it is something to keep in
303 mind when using method modifiers in a role. You should never assume any
308 The C<requires> keyword currently only works with actual methods. A method
309 modifier (before/around/after and override) will not count as a fufillment
310 of the requirement, and neither will an autogenerated accessor for an attribute.
312 It is likely that attribute accessors will eventually be allowed to fufill those
313 requirements, or we will introduce a C<requires_attr> keyword of some kind
314 instead. This decision has not yet been finalized.
320 All complex software has bugs lurking in it, and this module is no
321 exception. If you find a bug please either email me, or add the bug
326 Stevan Little E<lt>stevan@iinteractive.comE<gt>
328 Christian Hansen E<lt>chansen@cpan.orgE<gt>
330 =head1 COPYRIGHT AND LICENSE
332 Copyright 2006-2008 by Infinity Interactive, Inc.
334 L<http://www.iinteractive.com>
336 This library is free software; you can redistribute it and/or modify
337 it under the same terms as Perl itself.