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 =head1 CAVEATS
 225
 226 Role support has only a few caveats:
 227
 228 =over 4
 229
 230 =item *
 231
 232 Roles cannot use the C<extends> keyword; it will throw an exception for now.
 233 The same is true of the C<augment> and C<inner> keywords (not sure those
 234 really make sense for roles). All other Moose keywords will be I<deferred>
 235 so that they can be applied to the consuming class.
 236
 237 =item *
 238
 239 Role composition does its best to B<not> be order-sensitive when it comes to
 240 conflict resolution and requirements detection. However, it is order-sensitive
 241 when it comes to method modifiers. All before/around/after modifiers are
 242 included whenever a role is composed into a class, and then applied in the order
 243 in which the roles are used. This also means that there is no conflict for
 244 before/around/after modifiers.
 245
 246 In most cases, this will be a non-issue; however, it is something to keep in
 247 mind when using method modifiers in a role. You should never assume any
 248 ordering.
 249
 250 =item *
 251
 252 The C<requires> keyword currently only works with actual methods. A method
 253 modifier (before/around/after and override) will not count as a fufillment
 254 of the requirement, and neither will an autogenerated accessor for an attribute.
 255
 256 It is likely that attribute accessors will eventually be allowed to fufill those
 257 requirements, or we will introduce a C<requires_attr> keyword of some kind
 258 instead. This decision has not yet been finalized.
 259
 260 =back
 261
 262 =head1 BUGS
 263
 264 All complex software has bugs lurking in it, and this module is no
 265 exception. If you find a bug please either email me, or add the bug
 266 to cpan-RT.
 267
 268 =head1 AUTHOR
 269
 270 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 271
 272 Christian Hansen E<lt>chansen@cpan.orgE<gt>
 273
 274 =head1 COPYRIGHT AND LICENSE
 275
 276 Copyright 2006-2008 by Infinity Interactive, Inc.
 277
 278 L<http://www.iinteractive.com>
 279
 280 This library is free software; you can redistribute it and/or modify
 281 it under the same terms as Perl itself.
 282
 283 =cut