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