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->Moose::Meta::Class::add_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 = caller();
 163
 164         strict->import;
 165         warnings->import;
 166
 167         # we should never export to main
 168         return if $CALLER eq 'main';
 169
 170         goto $exporter;
 171     };
 172
 173 }
 174
 175 1;
 176
 177 __END__
 178
 179 =pod
 180
 181 =head1 NAME
 182
 183 Moose::Role - The Moose Role
 184
 185 =head1 SYNOPSIS
 186
 187   package Eq;
 188   use strict;
 189   use warnings;
 190   use Moose::Role;
 191
 192   requires 'equal';
 193
 194   sub no_equal {
 195       my ($self, $other) = @_;
 196       !$self->equal($other);
 197   }
 198
 199   # ... then in your classes
 200
 201   package Currency;
 202   use strict;
 203   use warnings;
 204   use Moose;
 205
 206   with 'Eq';
 207
 208   sub equal {
 209       my ($self, $other) = @_;
 210       $self->as_float == $other->as_float;
 211   }
 212
 213 =head1 DESCRIPTION
 214
 215 Role support in Moose is pretty solid at this point. However, the best
 216 documentation is still the the test suite. It is fairly safe to assume
 217 Perl 6 style behavior and then either refer to the test suite, or ask
 218 questions on #moose if something doesn't quite do what you expect.
 219
 220 We are planning writing some more documentation in the near future, but
 221 nothing is ready yet, sorry.
 222
 223 =head1 EXPORTED FUNCTIONS
 224
 225 Currently Moose::Role supports all of the functions that L<Moose> exports,
 226 but differs slightly in how some items are handled (see L<CAVEATS> below
 227 for details).
 228
 229 Moose::Role also offers two role specific keyword exports:
 230
 231 =over 4
 232
 233 =item B<requires (@method_names)>
 234
 235 Roles can require that certain methods are implemented by any class which
 236 C<does> the role.
 237
 238 =item B<excludes (@role_names)>
 239
 240 Roles can C<exclude> other roles, in effect saying "I can never be combined
 241 with these C<@role_names>". This is a feature which should not be used
 242 lightly.
 243
 244 =back
 245
 246 =head1 CAVEATS
 247
 248 The role support now has only a few caveats. They are as follows:
 249
 250 =over 4
 251
 252 =item *
 253
 254 Roles cannot use the C<extends> keyword, it will throw an exception for now.
 255 The same is true of the C<augment> and C<inner> keywords (not sure those
 256 really make sense for roles). All other Moose keywords will be I<deferred>
 257 so that they can be applied to the consuming class.
 258
 259 =item *
 260
 261 Role composition does it's best to B<not> be order sensitive when it comes
 262 to conflict resolution and requirements detection. However, it is order
 263 sensitive when it comes to method modifiers. All before/around/after modifiers
 264 are included whenever a role is composed into a class, and then are applied
 265 in the order the roles are used. This too means that there is no conflict for
 266 before/around/after modifiers as well.
 267
 268 In most cases, this will be a non issue, however it is something to keep in
 269 mind when using method modifiers in a role. You should never assume any
 270 ordering.
 271
 272 =item *
 273
 274 The C<requires> keyword currently only works with actual methods. A method
 275 modifier (before/around/after and override) will not count as a fufillment
 276 of the requirement, and neither will an autogenerated accessor for an attribute.
 277
 278 It is likely that the attribute accessors will eventually be allowed to fufill
 279 those requirements, either that or we will introduce a C<requires_attr> keyword
 280 of some kind instead. This descision has not yet been finalized.
 281
 282 =back
 283
 284 =head1 BUGS
 285
 286 All complex software has bugs lurking in it, and this module is no
 287 exception. If you find a bug please either email me, or add the bug
 288 to cpan-RT.
 289
 290 =head1 AUTHOR
 291
 292 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 293
 294 Christian Hansen E<lt>chansen@cpan.orgE<gt>
 295
 296 =head1 COPYRIGHT AND LICENSE
 297
 298 Copyright 2006, 2007 by Infinity Interactive, Inc.
 299
 300 L<http://www.iinteractive.com>
 301
 302 This library is free software; you can redistribute it and/or modify
 303 it under the same terms as Perl itself.
 304
 305 =cut