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