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