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