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