9 use Sub::Name 'subname';
13 our $VERSION = '0.03';
15 use Moose::Meta::Role;
16 use Moose::Util::TypeConstraints;
19 my ( $CALLER, %METAS );
24 return $METAS{$role} if exists $METAS{$role};
26 # make a subtype for each Moose class
29 => where { $_->does($role) }
30 unless find_type_constraint($role);
33 if ($role->can('meta')) {
34 $meta = $role->meta();
35 (blessed($meta) && $meta->isa('Moose::Meta::Role'))
36 || confess "Whoops, not møøsey enough";
39 $meta = Moose::Meta::Role->new(role_name => $role);
40 $meta->_role_meta->add_method('meta' => sub { $meta })
43 return $METAS{$role} = $meta;
49 my $meta = _find_meta();
50 return subname 'Moose::Role::extends' => sub {
51 confess "Moose::Role does not currently support 'extends'"
55 my $meta = _find_meta();
56 return subname 'Moose::Role::with' => sub {
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"
62 if (scalar @roles == 1) {
63 $roles[0]->meta->apply($meta);
66 Moose::Meta::Role->combine(
67 map { $_->meta } @roles
73 my $meta = _find_meta();
74 return subname 'Moose::Role::requires' => sub {
75 $meta->add_required_methods(@_);
79 my $meta = _find_meta();
80 return subname 'Moose::Role::has' => sub {
81 my ($name, %options) = @_;
82 $meta->add_attribute($name, %options)
86 my $meta = _find_meta();
87 return subname 'Moose::Role::before' => sub {
89 $meta->add_before_method_modifier($_, $code) for @_;
93 my $meta = _find_meta();
94 return subname 'Moose::Role::after' => sub {
96 $meta->add_after_method_modifier($_, $code) for @_;
100 my $meta = _find_meta();
101 return subname 'Moose::Role::around' => sub {
103 $meta->add_around_method_modifier($_, $code) for @_;
107 my $meta = _find_meta();
108 return subname 'Moose::Role::super' => sub {};
111 my $meta = _find_meta();
112 return subname 'Moose::Role::override' => sub {
113 my ($name, $code) = @_;
114 $meta->add_override_method_modifier($name, $code);
118 my $meta = _find_meta();
119 return subname 'Moose::Role::inner' => sub {
120 confess "Moose::Role does not currently support 'inner'";
124 my $meta = _find_meta();
125 return subname 'Moose::Role::augment' => sub {
126 confess "Moose::Role does not currently support 'augment'";
130 return \&Carp::confess;
133 return \&Scalar::Util::blessed;
137 my $exporter = Sub::Exporter::build_exporter({
138 exports => \%exports,
147 # we should never export to main
148 return if $CALLER eq 'main';
163 Moose::Role - The Moose Role
175 my ($self, $other) = @_;
176 !$self->equal($other);
179 # ... then in your classes
189 my ($self, $other) = @_;
190 $self->as_float == $other->as_float;
195 This is currently a very early release of Perl 6 style Roles for
196 Moose, it is still incomplete, but getting much closer. If you are
197 interested in helping move this feature along, please come to
198 #moose on irc.perl.org and we can talk.
202 Currently, the role support has a few of caveats. They are as follows:
208 At this time classes I<cannot> correctly consume more than one role. The
209 role composition process, and it's conflict detection has not been added
210 yet. While this should be considered a major feature, it can easily be
211 worked around, and in many cases, is not needed at all.
213 A class can actually consume multiple roles, they are just applied one
214 after another in the order you ask for them. This is incorrect behavior,
215 the roles should be merged first, and conflicts determined, etc. However,
216 if your roles do not have any conflicts, then things will work just
217 fine. This actually tends to be quite sufficient for basic roles.
221 Roles cannot use the C<extends> keyword, it will throw an exception for now.
222 The same is true of the C<augment> and C<inner> keywords (not sure those
223 really make sense for roles). All other Moose keywords will be I<deferred>
224 so that they can be applied to the consuming class.
230 All complex software has bugs lurking in it, and this module is no
231 exception. If you find a bug please either email me, or add the bug
236 Stevan Little E<lt>stevan@iinteractive.comE<gt>
238 Christian Hansen E<lt>chansen@cpan.orgE<gt>
240 =head1 COPYRIGHT AND LICENSE
242 Copyright 2006 by Infinity Interactive, Inc.
244 L<http://www.iinteractive.com>
246 This library is free software; you can redistribute it and/or modify
247 it under the same terms as Perl itself.