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.78';
  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 _add_method_modifier {
  50     my $type = shift;
  51     my $meta = Moose::Meta::Role->initialize(shift);
  52     my $code = pop @_;
  53
  54     for (@_) {
  55         croak "Roles do not currently support "
  56             . ref($_)
  57             . " references for $type method modifiers"
  58             if ref $_;
  59         my $add_method = "add_${type}_method_modifier";
  60         $meta->$add_method( $_, $code );
  61     }
  62 }
  63
  64 sub before { _add_method_modifier('before', @_) }
  65
  66 sub after  { _add_method_modifier('after',  @_) }
  67
  68 sub around { _add_method_modifier('around', @_) }
  69
  70 # see Moose.pm for discussion
  71 sub super {
  72     return unless $Moose::SUPER_BODY;
  73     $Moose::SUPER_BODY->(@Moose::SUPER_ARGS);
  74 }
  75
  76 sub override {
  77     my $meta = Moose::Meta::Role->initialize(shift);
  78     my ( $name, $code ) = @_;
  79     $meta->add_override_method_modifier( $name, $code );
  80 }
  81
  82 sub inner {
  83     croak "Roles cannot support 'inner'";
  84 }
  85
  86 sub augment {
  87     croak "Roles cannot support 'augment'";
  88 }
  89
  90 Moose::Exporter->setup_import_methods(
  91     with_caller => [
  92         qw( with requires excludes has before after around override make_immutable )
  93     ],
  94     as_is => [
  95         qw( extends super inner augment ),
  96         \&Carp::confess,
  97         \&Scalar::Util::blessed,
  98     ],
  99 );
 100
 101 sub init_meta {
 102     shift;
 103     my %args = @_;
 104
 105     my $role = $args{for_class};
 106
 107     unless ($role) {
 108         require Moose;
 109         Moose->throw_error("Cannot call init_meta without specifying a for_class");
 110     }
 111
 112     my $metaclass = $args{metaclass} || "Moose::Meta::Role";
 113
 114     # make a subtype for each Moose class
 115     role_type $role unless find_type_constraint($role);
 116
 117     # FIXME copy from Moose.pm
 118     my $meta;
 119     if ($role->can('meta')) {
 120         $meta = $role->meta();
 121
 122         unless ( blessed($meta) && $meta->isa('Moose::Meta::Role') ) {
 123             require Moose;
 124             Moose->throw_error("You already have a &meta function, but it does not return a Moose::Meta::Role");
 125         }
 126     }
 127     else {
 128         $meta = $metaclass->initialize($role);
 129
 130         $meta->add_method(
 131             'meta' => sub {
 132                 # re-initialize so it inherits properly
 133                 $metaclass->initialize( ref($_[0]) || $_[0] );
 134             }
 135         );
 136     }
 137
 138     return $meta;
 139 }
 140
 141 1;
 142
 143 __END__
 144
 145 =pod
 146
 147 =head1 NAME
 148
 149 Moose::Role - The Moose Role
 150
 151 =head1 SYNOPSIS
 152
 153   package Eq;
 154   use Moose::Role; # automatically turns on strict and warnings
 155
 156   requires 'equal';
 157
 158   sub no_equal {
 159       my ($self, $other) = @_;
 160       !$self->equal($other);
 161   }
 162
 163   # ... then in your classes
 164
 165   package Currency;
 166   use Moose; # automatically turns on strict and warnings
 167
 168   with 'Eq';
 169
 170   sub equal {
 171       my ($self, $other) = @_;
 172       $self->as_float == $other->as_float;
 173   }
 174
 175 =head1 DESCRIPTION
 176
 177 Role support in Moose is pretty solid at this point. However, the best
 178 documentation is still the the test suite. It is fairly safe to assume Perl 6
 179 style behavior and then either refer to the test suite, or ask questions on
 180 #moose if something doesn't quite do what you expect.
 181
 182 We are planning writing some more documentation in the near future, but nothing
 183 is ready yet, sorry.
 184
 185 =head1 EXPORTED FUNCTIONS
 186
 187 Moose::Role currently supports all of the functions that L<Moose> exports, but
 188 differs slightly in how some items are handled (see L<CAVEATS> below for
 189 details).
 190
 191 Moose::Role also offers two role-specific keyword exports:
 192
 193 =over 4
 194
 195 =item B<requires (@method_names)>
 196
 197 Roles can require that certain methods are implemented by any class which
 198 C<does> the role.
 199
 200 =item B<excludes (@role_names)>
 201
 202 Roles can C<exclude> other roles, in effect saying "I can never be combined
 203 with these C<@role_names>". This is a feature which should not be used
 204 lightly.
 205
 206 =back
 207
 208 =head2 B<unimport>
 209
 210 Moose::Role offers a way to remove the keywords it exports, through the
 211 C<unimport> method. You simply have to say C<no Moose::Role> at the bottom of
 212 your code for this to work.
 213
 214 =head2 B<< Moose::Role->init_meta(for_class => $role, metaclass => $metaclass) >>
 215
 216 The C<init_meta> method sets up the metaclass object for the role
 217 specified by C<for_class>. It also injects a a C<meta> accessor into
 218 the role so you can get at this object.
 219
 220 The default metaclass is L<Moose::Meta::Role>. You can specify an
 221 alternate metaclass with the C<metaclass> parameter.
 222
 223 =head1 METACLASS
 224
 225 When you use Moose::Role, you can specify which metaclass to use:
 226
 227     use Moose::Role -metaclass => 'My::Meta::Role';
 228
 229 You can also specify traits which will be applied to your role metaclass:
 230
 231     use Moose::Role -traits => 'My::Trait';
 232
 233 This is very similar to the attribute traits feature. When you do
 234 this, your class's C<meta> object will have the specified traits
 235 applied to it. See L<Moose/TRAIT NAME RESOLUTION> for more details.
 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 =back
 264
 265 =head1 BUGS
 266
 267 All complex software has bugs lurking in it, and this module is no
 268 exception. If you find a bug please either email me, or add the bug
 269 to cpan-RT.
 270
 271 =head1 AUTHOR
 272
 273 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 274
 275 Christian Hansen E<lt>chansen@cpan.orgE<gt>
 276
 277 =head1 COPYRIGHT AND LICENSE
 278
 279 Copyright 2006-2009 by Infinity Interactive, Inc.
 280
 281 L<http://www.iinteractive.com>
 282
 283 This library is free software; you can redistribute it and/or modify
 284 it under the same terms as Perl itself.
 285
 286 =cut