lib/Mouse/Role.pm

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