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