lib/Moose/Role.pm

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