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