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( shift->meta(), @_ );
  28 }
  29
  30 sub requires {
  31     my $meta = shift->meta();
  32     croak "Must specify at least one method" unless @_;
  33     $meta->add_required_methods(@_);
  34 }
  35
  36 sub excludes {
  37     my $meta = shift->meta();
  38     croak "Must specify at least one role" unless @_;
  39     $meta->add_excluded_roles(@_);
  40 }
  41
  42 sub has {
  43     my $meta = shift->meta();
  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 = shift->meta();
  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 = shift->meta();
  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 = shift->meta();
  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 = shift->meta();
  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->build_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     also => sub { init_meta(shift) },
 119 );
 120
 121 {
 122     my %METAS;
 123
 124     sub init_meta {
 125         my $role = shift;
 126
 127         return $METAS{$role} if exists $METAS{$role};
 128
 129         # make a subtype for each Moose class
 130         role_type $role unless find_type_constraint($role);
 131
 132         my $meta;
 133         if ($role->can('meta')) {
 134             $meta = $role->meta();
 135             (blessed($meta) && $meta->isa('Moose::Meta::Role'))
 136                 || confess "You already have a &meta function, but it does not return a Moose::Meta::Role";
 137         }
 138         else {
 139             $meta = Moose::Meta::Role->initialize($role);
 140             $meta->alias_method('meta' => sub { $meta });
 141         }
 142
 143         return $METAS{$role} = $meta;
 144     }
 145 }
 146
 147 1;
 148
 149 __END__
 150
 151 =pod
 152
 153 =head1 NAME
 154
 155 Moose::Role - The Moose Role
 156
 157 =head1 SYNOPSIS
 158
 159   package Eq;
 160   use Moose::Role; # automatically turns on strict and warnings
 161
 162   requires 'equal';
 163
 164   sub no_equal {
 165       my ($self, $other) = @_;
 166       !$self->equal($other);
 167   }
 168
 169   # ... then in your classes
 170
 171   package Currency;
 172   use Moose; # automatically turns on strict and warnings
 173
 174   with 'Eq';
 175
 176   sub equal {
 177       my ($self, $other) = @_;
 178       $self->as_float == $other->as_float;
 179   }
 180
 181 =head1 DESCRIPTION
 182
 183 Role support in Moose is pretty solid at this point. However, the best
 184 documentation is still the the test suite. It is fairly safe to assume Perl 6
 185 style behavior and then either refer to the test suite, or ask questions on
 186 #moose if something doesn't quite do what you expect.
 187
 188 We are planning writing some more documentation in the near future, but nothing
 189 is ready yet, sorry.
 190
 191 =head1 EXPORTED FUNCTIONS
 192
 193 Moose::Role currently supports all of the functions that L<Moose> exports, but
 194 differs slightly in how some items are handled (see L<CAVEATS> below for
 195 details).
 196
 197 Moose::Role also offers two role-specific keyword exports:
 198
 199 =over 4
 200
 201 =item B<requires (@method_names)>
 202
 203 Roles can require that certain methods are implemented by any class which
 204 C<does> the role.
 205
 206 =item B<excludes (@role_names)>
 207
 208 Roles can C<exclude> other roles, in effect saying "I can never be combined
 209 with these C<@role_names>". This is a feature which should not be used
 210 lightly.
 211
 212 =back
 213
 214 =head2 B<unimport>
 215
 216 Moose::Role offers a way to remove the keywords it exports, through the
 217 C<unimport> method. You simply have to say C<no Moose::Role> at the bottom of
 218 your code for this to work.
 219
 220 =head1 CAVEATS
 221
 222 Role support has only a few caveats:
 223
 224 =over 4
 225
 226 =item *
 227
 228 Roles cannot use the C<extends> keyword; it will throw an exception for now.
 229 The same is true of the C<augment> and C<inner> keywords (not sure those
 230 really make sense for roles). All other Moose keywords will be I<deferred>
 231 so that they can be applied to the consuming class.
 232
 233 =item *
 234
 235 Role composition does its best to B<not> be order-sensitive when it comes to
 236 conflict resolution and requirements detection. However, it is order-sensitive
 237 when it comes to method modifiers. All before/around/after modifiers are
 238 included whenever a role is composed into a class, and then applied in the order
 239 in which the roles are used. This also means that there is no conflict for
 240 before/around/after modifiers.
 241
 242 In most cases, this will be a non-issue; however, it is something to keep in
 243 mind when using method modifiers in a role. You should never assume any
 244 ordering.
 245
 246 =item *
 247
 248 The C<requires> keyword currently only works with actual methods. A method
 249 modifier (before/around/after and override) will not count as a fufillment
 250 of the requirement, and neither will an autogenerated accessor for an attribute.
 251
 252 It is likely that attribute accessors will eventually be allowed to fufill those
 253 requirements, or we will introduce a C<requires_attr> keyword of some kind
 254 instead. This decision has not yet been finalized.
 255
 256 =back
 257
 258 =head1 BUGS
 259
 260 All complex software has bugs lurking in it, and this module is no
 261 exception. If you find a bug please either email me, or add the bug
 262 to cpan-RT.
 263
 264 =head1 AUTHOR
 265
 266 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 267
 268 Christian Hansen E<lt>chansen@cpan.orgE<gt>
 269
 270 =head1 COPYRIGHT AND LICENSE
 271
 272 Copyright 2006-2008 by Infinity Interactive, Inc.
 273
 274 L<http://www.iinteractive.com>
 275
 276 This library is free software; you can redistribute it and/or modify
 277 it under the same terms as Perl itself.
 278
 279 =cut