lib/Mouse/Role.pm

   1 package Mouse::Role;
   2 use strict;
   3 use warnings;
   4 use base 'Exporter';
   5
   6 use Carp 'confess';
   7 use Scalar::Util 'blessed';
   8
   9 use Mouse::Util qw(load_class not_supported);
  10 use Mouse ();
  11
  12 our @EXPORT = qw(
  13     extends with
  14     has
  15     before after around
  16     override super
  17     augment  inner
  18
  19     requires excludes
  20
  21     blessed confess
  22 );
  23
  24 our %is_removable = map{ $_ => undef } @EXPORT;
  25 delete $is_removable{confess};
  26 delete $is_removable{blessed};
  27
  28 sub before {
  29     my $meta = Mouse::Meta::Role->initialize(scalar caller);
  30
  31     my $code = pop;
  32     for (@_) {
  33         $meta->add_before_method_modifier($_ => $code);
  34     }
  35 }
  36
  37 sub after {
  38     my $meta = Mouse::Meta::Role->initialize(scalar caller);
  39
  40     my $code = pop;
  41     for (@_) {
  42         $meta->add_after_method_modifier($_ => $code);
  43     }
  44 }
  45
  46 sub around {
  47     my $meta = Mouse::Meta::Role->initialize(scalar caller);
  48
  49     my $code = pop;
  50     for (@_) {
  51         $meta->add_around_method_modifier($_ => $code);
  52     }
  53 }
  54
  55
  56 sub super {
  57     return unless $Mouse::SUPER_BODY;
  58     $Mouse::SUPER_BODY->(@Mouse::SUPER_ARGS);
  59 }
  60
  61 sub override {
  62     my $classname = caller;
  63     my $meta = Mouse::Meta::Role->initialize($classname);
  64
  65     my $name = shift;
  66     my $code = shift;
  67     my $fullname = "${classname}::${name}";
  68
  69     defined &$fullname
  70         && $meta->throw_error("Cannot add an override of method '$fullname' "
  71                             . "because there is a local version of '$fullname'");
  72
  73     $meta->add_override_method_modifier($name => sub {
  74         local $Mouse::SUPER_PACKAGE = shift;
  75         local $Mouse::SUPER_BODY = shift;
  76         local @Mouse::SUPER_ARGS = @_;
  77
  78         $code->(@_);
  79     });
  80 }
  81
  82 # We keep the same errors messages as Moose::Role emits, here.
  83 sub inner {
  84     Carp::croak "Roles cannot support 'inner'";
  85 }
  86
  87 sub augment {
  88     Carp::croak "Roles cannot support 'augment'";
  89 }
  90
  91 sub has {
  92     my $meta = Mouse::Meta::Role->initialize(scalar caller);
  93     my $name = shift;
  94
  95     $meta->add_attribute($_ => @_) for ref($name) ? @{$name} : $name;
  96 }
  97
  98 sub extends  {
  99     Carp::croak "Roles do not support 'extends'"
 100 }
 101
 102 sub with     {
 103     my $meta = Mouse::Meta::Role->initialize(scalar caller);
 104     Mouse::Util::apply_all_roles($meta->name, @_);
 105 }
 106
 107 sub requires {
 108     my $meta = Mouse::Meta::Role->initialize(scalar caller);
 109     $meta->throw_error("Must specify at least one method") unless @_;
 110     $meta->add_required_methods(@_);
 111 }
 112
 113 sub excludes {
 114     not_supported;
 115 }
 116
 117 sub import {
 118     my $class = shift;
 119
 120     strict->import;
 121     warnings->import;
 122
 123     my $caller = caller;
 124
 125     # we should never export to main
 126     if ($caller eq 'main') {
 127         warn qq{$class does not export its sugar to the 'main' package.\n};
 128         return;
 129     }
 130
 131     Mouse::Meta::Role->initialize($caller)->add_method(meta => sub {
 132         return Mouse::Meta::Role->initialize(ref($_[0]) || $_[0]);
 133     });
 134
 135     Mouse::Role->export_to_level(1, @_);
 136 }
 137
 138 sub unimport {
 139     my $caller = caller;
 140
 141     my $stash = do{
 142         no strict 'refs';
 143         \%{$caller . '::'}
 144     };
 145
 146     for my $keyword (@EXPORT) {
 147         my $code;
 148         if(exists $is_removable{$keyword}
 149             && ($code = $caller->can($keyword))
 150             && (Mouse::Util::get_code_info($code))[0] eq __PACKAGE__){
 151
 152             delete $stash->{$keyword};
 153         }
 154     }
 155     return;
 156 }
 157
 158 1;
 159
 160 __END__
 161
 162 =head1 NAME
 163
 164 Mouse::Role - The Mouse Role
 165
 166 =head1 SYNOPSIS
 167
 168     package MyRole;
 169     use Mouse::Role;
 170
 171 =head1 KEYWORDS
 172
 173 =head2 C<< meta -> Mouse::Meta::Role >>
 174
 175 Returns this role's metaclass instance.
 176
 177 =head2 C<< before (method|methods) -> CodeRef >>
 178
 179 Sets up a B<before> method modifier. See L<Moose/before> or
 180 L<Class::Method::Modifiers/before>.
 181
 182 =head2 C<< after (method|methods) => CodeRef >>
 183
 184 Sets up an B<after> method modifier. See L<Moose/after> or
 185 L<Class::Method::Modifiers/after>.
 186
 187 =head2 C<< around (method|methods) => CodeRef >>
 188
 189 Sets up an B<around> method modifier. See L<Moose/around> or
 190 L<Class::Method::Modifiers/around>.
 191
 192 =head2 C<super>
 193
 194 Sets up the B<super> keyword. See L<Moose/super>.
 195
 196 =head2  C<< override method => CodeRef >>
 197
 198 Sets up an B<override> method modifier. See L<Moose/Role/override>.
 199
 200 =head2 C<inner>
 201
 202 This is not supported in roles and emits an error. See L<Moose/Role>.
 203
 204 =head2 C<< augment method => CodeRef >>
 205
 206 This is not supported in roles and emits an error. See L<Moose/Role>.
 207
 208 =head2 C<< has (name|names) => parameters >>
 209
 210 Sets up an attribute (or if passed an arrayref of names, multiple attributes) to
 211 this role. See L<Mouse/has>.
 212
 213 =head2 C<< confess(error) -> BOOM >>
 214
 215 L<Carp/confess> for your convenience.
 216
 217 =head2 C<< blessed(value) -> ClassName | undef >>
 218
 219 L<Scalar::Util/blessed> for your convenience.
 220
 221 =head1 MISC
 222
 223 =head2 import
 224
 225 Importing Mouse::Role will give you sugar.
 226
 227 =head2 unimport
 228
 229 Please unimport (C<< no Mouse::Role >>) so that if someone calls one of the
 230 keywords (such as L</has>) it will break loudly instead breaking subtly.
 231
 232 =head1 SEE ALSO
 233
 234 L<Moose::Role>
 235
 236 =cut
 237