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