lib/Moose/Role.pm

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