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.75_01';
  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
 128     unless ($role) {
 129         require Moose;
 130         Moose->throw_error("Cannot call init_meta without specifying a for_class");
 131     }
 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     # FIXME copy from Moose.pm
 139     my $meta;
 140     if ($role->can('meta')) {
 141         $meta = $role->meta();
 142
 143         unless ( blessed($meta) && $meta->isa('Moose::Meta::Role') ) {
 144             require Moose;
 145             Moose->throw_error("You already have a &meta function, but it does not return a Moose::Meta::Role");
 146         }
 147     }
 148     else {
 149         $meta = $metaclass->initialize($role);
 150
 151         $meta->add_method(
 152             'meta' => sub {
 153                 # re-initialize so it inherits properly
 154                 $metaclass->initialize( ref($_[0]) || $_[0] );
 155             }
 156         );
 157     }
 158
 159     return $meta;
 160 }
 161
 162 1;
 163
 164 __END__
 165
 166 =pod
 167
 168 =head1 NAME
 169
 170 Moose::Role - The Moose Role
 171
 172 =head1 SYNOPSIS
 173
 174   package Eq;
 175   use Moose::Role; # automatically turns on strict and warnings
 176
 177   requires 'equal';
 178
 179   sub no_equal {
 180       my ($self, $other) = @_;
 181       !$self->equal($other);
 182   }
 183
 184   # ... then in your classes
 185
 186   package Currency;
 187   use Moose; # automatically turns on strict and warnings
 188
 189   with 'Eq';
 190
 191   sub equal {
 192       my ($self, $other) = @_;
 193       $self->as_float == $other->as_float;
 194   }
 195
 196 =head1 DESCRIPTION
 197
 198 Role support in Moose is pretty solid at this point. However, the best
 199 documentation is still the the test suite. It is fairly safe to assume Perl 6
 200 style behavior and then either refer to the test suite, or ask questions on
 201 #moose if something doesn't quite do what you expect.
 202
 203 We are planning writing some more documentation in the near future, but nothing
 204 is ready yet, sorry.
 205
 206 =head1 EXPORTED FUNCTIONS
 207
 208 Moose::Role currently supports all of the functions that L<Moose> exports, but
 209 differs slightly in how some items are handled (see L<CAVEATS> below for
 210 details).
 211
 212 Moose::Role also offers two role-specific keyword exports:
 213
 214 =over 4
 215
 216 =item B<requires (@method_names)>
 217
 218 Roles can require that certain methods are implemented by any class which
 219 C<does> the role.
 220
 221 =item B<excludes (@role_names)>
 222
 223 Roles can C<exclude> other roles, in effect saying "I can never be combined
 224 with these C<@role_names>". This is a feature which should not be used
 225 lightly.
 226
 227 =back
 228
 229 =head2 B<unimport>
 230
 231 Moose::Role offers a way to remove the keywords it exports, through the
 232 C<unimport> method. You simply have to say C<no Moose::Role> at the bottom of
 233 your code for this to work.
 234
 235 =head2 B<< Moose::Role->init_meta(for_class => $role, metaclass => $metaclass) >>
 236
 237 The C<init_meta> method sets up the metaclass object for the role
 238 specified by C<for_class>. It also injects a a C<meta> accessor into
 239 the role so you can get at this object.
 240
 241 The default metaclass is L<Moose::Meta::Role>. You can specify an
 242 alternate metaclass with the C<metaclass> parameter.
 243
 244 =head1 METACLASS
 245
 246 When you use Moose::Role, you can specify which metaclass to use:
 247
 248     use Moose::Role -metaclass => 'My::Meta::Role';
 249
 250 You can also specify traits which will be applied to your role metaclass:
 251
 252     use Moose::Role -traits => 'My::Trait';
 253
 254 This is very similar to the attribute traits feature. When you do
 255 this, your class's C<meta> object will have the specified traits
 256 applied to it. See L<Moose/TRAIT NAME RESOLUTION> for more details.
 257
 258 =head1 CAVEATS
 259
 260 Role support has only a few caveats:
 261
 262 =over 4
 263
 264 =item *
 265
 266 Roles cannot use the C<extends> keyword; it will throw an exception for now.
 267 The same is true of the C<augment> and C<inner> keywords (not sure those
 268 really make sense for roles). All other Moose keywords will be I<deferred>
 269 so that they can be applied to the consuming class.
 270
 271 =item *
 272
 273 Role composition does its best to B<not> be order-sensitive when it comes to
 274 conflict resolution and requirements detection. However, it is order-sensitive
 275 when it comes to method modifiers. All before/around/after modifiers are
 276 included whenever a role is composed into a class, and then applied in the order
 277 in which the roles are used. This also means that there is no conflict for
 278 before/around/after modifiers.
 279
 280 In most cases, this will be a non-issue; however, it is something to keep in
 281 mind when using method modifiers in a role. You should never assume any
 282 ordering.
 283
 284 =back
 285
 286 =head1 BUGS
 287
 288 All complex software has bugs lurking in it, and this module is no
 289 exception. If you find a bug please either email me, or add the bug
 290 to cpan-RT.
 291
 292 =head1 AUTHOR
 293
 294 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 295
 296 Christian Hansen E<lt>chansen@cpan.orgE<gt>
 297
 298 =head1 COPYRIGHT AND LICENSE
 299
 300 Copyright 2006-2009 by Infinity Interactive, Inc.
 301
 302 L<http://www.iinteractive.com>
 303
 304 This library is free software; you can redistribute it and/or modify
 305 it under the same terms as Perl itself.
 306
 307 =cut