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.05';
  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         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                 Moose::_load_all_classes(@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             my $meta = _find_meta();
 121             return subname 'Moose::Role::super' => sub {};
 122         },
 123         override => sub {
 124             my $meta = _find_meta();
 125             return subname 'Moose::Role::override' => sub ($&) {
 126                 my ($name, $code) = @_;
 127                 $meta->add_override_method_modifier($name, $code);
 128                 };
 129             },
 130         inner => sub {
 131             my $meta = _find_meta();
 132             return subname 'Moose::Role::inner' => sub {
 133                 confess "Moose::Role cannot support 'inner'";
 134                 };
 135             },
 136         augment => sub {
 137             my $meta = _find_meta();
 138             return subname 'Moose::Role::augment' => sub {
 139                 confess "Moose::Role cannot support 'augment'";
 140                 };
 141             },
 142         confess => sub {
 143             return \&Carp::confess;
 144         },
 145         blessed => sub {
 146             return \&Scalar::Util::blessed;
 147         }
 148         );
 149
 150     my $exporter = Sub::Exporter::build_exporter({
 151         exports => \%exports,
 152         groups  => {
 153             default => [':all']
 154         }
 155     });
 156
 157     sub import {
 158         $CALLER = caller();
 159
 160         strict->import;
 161         warnings->import;
 162
 163         # we should never export to main
 164         return if $CALLER eq 'main';
 165
 166         goto $exporter;
 167     };
 168
 169 }
 170
 171 1;
 172
 173 __END__
 174
 175 =pod
 176
 177 =head1 NAME
 178
 179 Moose::Role - The Moose Role
 180
 181 =head1 SYNOPSIS
 182
 183   package Eq;
 184   use strict;
 185   use warnings;
 186   use Moose::Role;
 187
 188   requires 'equal';
 189
 190   sub no_equal {
 191       my ($self, $other) = @_;
 192       !$self->equal($other);
 193   }
 194
 195   # ... then in your classes
 196
 197   package Currency;
 198   use strict;
 199   use warnings;
 200   use Moose;
 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 coming along quite well. It's best documentation
 212 is still the the test suite, but it is fairly safe to assume Perl 6 style
 213 behavior, and then either refer to the test suite, or ask questions on
 214 #moose if something doesn't quite do what you expect. More complete
 215 documentation is planned and will be included with the next official
 216 (non-developer) release.
 217
 218 =head1 EXPORTED FUNCTIONS
 219
 220 Currently Moose::Role supports all of the functions that L<Moose> exports,
 221 but differs slightly in how some items are handled (see L<CAVEATS> below
 222 for details).
 223
 224 Moose::Role also offers two role specific keyword exports:
 225
 226 =over 4
 227
 228 =item B<requires (@method_names)>
 229
 230 Roles can require that certain methods are implemented by any class which
 231 C<does> the role.
 232
 233 =item B<excludes (@role_names)>
 234
 235 Roles can C<exclude> other roles, in effect saying "I can never be combined
 236 with these C<@role_names>". This is a feature which should not be used
 237 lightly.
 238
 239 =back
 240
 241 =head1 CAVEATS
 242
 243 The role support now has only a few caveats. They are as follows:
 244
 245 =over 4
 246
 247 =item *
 248
 249 Roles cannot use the C<extends> keyword, it will throw an exception for now.
 250 The same is true of the C<augment> and C<inner> keywords (not sure those
 251 really make sense for roles). All other Moose keywords will be I<deferred>
 252 so that they can be applied to the consuming class.
 253
 254 =item *
 255
 256 Role composition does it's best to B<not> be order sensitive when it comes
 257 to conflict resolution and requirements detection. However, it is order
 258 sensitive when it comes to method modifiers. All before/around/after modifiers
 259 are included whenever a role is composed into a class, and then are applied
 260 in the order the roles are used. This too means that there is no conflict for
 261 before/around/after modifiers as well.
 262
 263 In most cases, this will be a non issue, however it is something to keep in
 264 mind when using method modifiers in a role. You should never assume any
 265 ordering.
 266
 267 =item *
 268
 269 The C<requires> keyword currently only works with actual methods. A method
 270 modifier (before/around/after and override) will not count as a fufillment
 271 of the requirement, and neither will an autogenerated accessor for an attribute.
 272
 273 It is likely that the attribute accessors will eventually be allowed to fufill
 274 those requirements, either that or we will introduce a C<requires_attr> keyword
 275 of some kind instead. This descision has not yet been finalized.
 276
 277 =back
 278
 279 =head1 BUGS
 280
 281 All complex software has bugs lurking in it, and this module is no
 282 exception. If you find a bug please either email me, or add the bug
 283 to cpan-RT.
 284
 285 =head1 AUTHOR
 286
 287 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 288
 289 Christian Hansen E<lt>chansen@cpan.orgE<gt>
 290
 291 =head1 COPYRIGHT AND LICENSE
 292
 293 Copyright 2006 by Infinity Interactive, Inc.
 294
 295 L<http://www.iinteractive.com>
 296
 297 This library is free software; you can redistribute it and/or modify
 298 it under the same terms as Perl itself.
 299
 300 =cut