lib/Moose/Role.pm

   1
   2 use lib '/Users/stevan/Projects/Moose/Moose/Class-MOP/branches/Class-MOP-tranformations/lib';
   3
   4 package Moose::Role;
   5
   6 use strict;
   7 use warnings;
   8
   9 use Scalar::Util 'blessed';
  10 use Carp         'confess';
  11 use Sub::Name    'subname';
  12
  13 use Sub::Exporter;
  14
  15 our $VERSION = '0.06';
  16
  17 use Moose ();
  18
  19 use Moose::Meta::Role;
  20 use Moose::Util::TypeConstraints;
  21
  22 {
  23     my ( $CALLER, %METAS );
  24
  25     sub _find_meta {
  26         my $role = $CALLER;
  27
  28         return $METAS{$role} if exists $METAS{$role};
  29
  30         # make a subtype for each Moose class
  31         subtype $role
  32             => as 'Role'
  33             => where { $_->does($role) }
  34             => optimize_as { blessed($_[0]) && $_[0]->can('does') && $_[0]->does($role) }
  35         unless find_type_constraint($role);
  36
  37         my $meta;
  38         if ($role->can('meta')) {
  39                 $meta = $role->meta();
  40                 (blessed($meta) && $meta->isa('Moose::Meta::Role'))
  41                 || confess "You already have a &meta function, but it does not return a Moose::Meta::Role";
  42         }
  43         else {
  44                 $meta = Moose::Meta::Role->initialize($role);
  45                 $meta->Moose::Meta::Class::add_method('meta' => sub { $meta })
  46         }
  47
  48         return $METAS{$role} = $meta;
  49     }
  50
  51
  52     my %exports = (
  53         extends => sub {
  54             my $meta = _find_meta();
  55             return subname 'Moose::Role::extends' => sub {
  56                 confess "Moose::Role does not currently support 'extends'"
  57                 };
  58             },
  59             with => sub {
  60                 my $meta = _find_meta();
  61                 return subname 'Moose::Role::with' => sub (@) {
  62                 my (@roles) = @_;
  63                 confess "Must specify at least one role" unless @roles;
  64                 Moose::_load_all_classes(@roles);
  65                 ($_->can('meta') && $_->meta->isa('Moose::Meta::Role'))
  66                     || confess "You can only consume roles, $_ is not a Moose role"
  67                         foreach @roles;
  68                 if (scalar @roles == 1) {
  69                     $roles[0]->meta->apply($meta);
  70                 }
  71                 else {
  72                     Moose::Meta::Role->combine(
  73                         map { $_->meta } @roles
  74                     )->apply($meta);
  75                 }
  76             };
  77             },
  78         requires => sub {
  79             my $meta = _find_meta();
  80             return subname 'Moose::Role::requires' => sub (@) {
  81                 confess "Must specify at least one method" unless @_;
  82                 $meta->add_required_methods(@_);
  83                 };
  84             },
  85         excludes => sub {
  86             my $meta = _find_meta();
  87             return subname 'Moose::Role::excludes' => sub (@) {
  88                 confess "Must specify at least one role" unless @_;
  89                 $meta->add_excluded_roles(@_);
  90                 };
  91             },
  92         has => sub {
  93             my $meta = _find_meta();
  94             return subname 'Moose::Role::has' => sub ($;%) {
  95                         my ($name, %options) = @_;
  96                         $meta->add_attribute($name, %options)
  97                 };
  98             },
  99         before => sub {
 100             my $meta = _find_meta();
 101             return subname 'Moose::Role::before' => sub (@&) {
 102                 my $code = pop @_;
 103                 $meta->add_before_method_modifier($_, $code) for @_;
 104                 };
 105             },
 106         after => sub {
 107             my $meta = _find_meta();
 108             return subname 'Moose::Role::after' => sub (@&) {
 109                         my $code = pop @_;
 110                         $meta->add_after_method_modifier($_, $code) for @_;
 111                 };
 112             },
 113         around => sub {
 114             my $meta = _find_meta();
 115             return subname 'Moose::Role::around' => sub (@&) {
 116                         my $code = pop @_;
 117                         $meta->add_around_method_modifier($_, $code) for @_;
 118                 };
 119             },
 120             super => sub {
 121             my $meta = _find_meta();
 122             return subname 'Moose::Role::super' => sub {};
 123         },
 124         override => sub {
 125             my $meta = _find_meta();
 126             return subname 'Moose::Role::override' => sub ($&) {
 127                 my ($name, $code) = @_;
 128                 $meta->add_override_method_modifier($name, $code);
 129                 };
 130             },
 131         inner => sub {
 132             my $meta = _find_meta();
 133             return subname 'Moose::Role::inner' => sub {
 134                 confess "Moose::Role cannot support 'inner'";
 135                 };
 136             },
 137         augment => sub {
 138             my $meta = _find_meta();
 139             return subname 'Moose::Role::augment' => sub {
 140                 confess "Moose::Role cannot support 'augment'";
 141                 };
 142             },
 143         confess => sub {
 144             return \&Carp::confess;
 145         },
 146         blessed => sub {
 147             return \&Scalar::Util::blessed;
 148         }
 149         );
 150
 151     my $exporter = Sub::Exporter::build_exporter({
 152         exports => \%exports,
 153         groups  => {
 154             default => [':all']
 155         }
 156     });
 157
 158     sub import {
 159         $CALLER = caller();
 160
 161         strict->import;
 162         warnings->import;
 163
 164         # we should never export to main
 165         return if $CALLER eq 'main';
 166
 167         goto $exporter;
 168     };
 169
 170 }
 171
 172 1;
 173
 174 __END__
 175
 176 =pod
 177
 178 =head1 NAME
 179
 180 Moose::Role - The Moose Role
 181
 182 =head1 SYNOPSIS
 183
 184   package Eq;
 185   use strict;
 186   use warnings;
 187   use Moose::Role;
 188
 189   requires 'equal';
 190
 191   sub no_equal {
 192       my ($self, $other) = @_;
 193       !$self->equal($other);
 194   }
 195
 196   # ... then in your classes
 197
 198   package Currency;
 199   use strict;
 200   use warnings;
 201   use Moose;
 202
 203   with 'Eq';
 204
 205   sub equal {
 206       my ($self, $other) = @_;
 207       $self->as_float == $other->as_float;
 208   }
 209
 210 =head1 DESCRIPTION
 211
 212 Role support in Moose is coming along quite well. It's best documentation
 213 is still the the test suite, but it is fairly safe to assume Perl 6 style
 214 behavior, and then either refer to the test suite, or ask questions on
 215 #moose if something doesn't quite do what you expect. More complete
 216 documentation is planned and will be included with the next official
 217 (non-developer) release.
 218
 219 =head1 EXPORTED FUNCTIONS
 220
 221 Currently Moose::Role supports all of the functions that L<Moose> exports,
 222 but differs slightly in how some items are handled (see L<CAVEATS> below
 223 for 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 The role support now has only a few caveats. They are as follows:
 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 it's best to B<not> be order sensitive when it comes
 258 to conflict resolution and requirements detection. However, it is order
 259 sensitive when it comes to method modifiers. All before/around/after modifiers
 260 are included whenever a role is composed into a class, and then are applied
 261 in the order the roles are used. This too means that there is no conflict for
 262 before/around/after modifiers as well.
 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 the attribute accessors will eventually be allowed to fufill
 275 those requirements, either that or we will introduce a C<requires_attr> keyword
 276 of some kind instead. This descision 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 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