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::Meta::Role;
  10
  11 our @EXPORT = qw(before after around has extends with requires excludes confess blessed);
  12
  13 sub before {
  14     my $meta = Mouse::Meta::Role->initialize(caller);
  15
  16     my $code = pop;
  17     for (@_) {
  18         $meta->add_before_method_modifier($_ => $code);
  19     }
  20 }
  21
  22 sub after {
  23     my $meta = Mouse::Meta::Role->initialize(caller);
  24
  25     my $code = pop;
  26     for (@_) {
  27         $meta->add_after_method_modifier($_ => $code);
  28     }
  29 }
  30
  31 sub around {
  32     my $meta = Mouse::Meta::Role->initialize(caller);
  33
  34     my $code = pop;
  35     for (@_) {
  36         $meta->add_around_method_modifier($_ => $code);
  37     }
  38 }
  39
  40 sub has {
  41     my $meta = Mouse::Meta::Role->initialize(caller);
  42
  43     my $name = shift;
  44     my %opts = @_;
  45
  46     $meta->add_attribute($name => \%opts);
  47 }
  48
  49 sub extends  { confess "Roles do not support 'extends'" }
  50
  51 sub with     {
  52     my $meta = Mouse::Meta::Role->initialize(caller);
  53     my $role  = shift;
  54     my $args  = shift || {};
  55     confess "Mouse::Role only supports 'with' on individual roles at a time" if @_ || !ref $args;
  56
  57     Mouse::load_class($role);
  58     $role->meta->apply($meta, %$args);
  59 }
  60
  61 sub requires {
  62     my $meta = Mouse::Meta::Role->initialize(caller);
  63     Carp::croak "Must specify at least one method" unless @_;
  64     $meta->add_required_methods(@_);
  65 }
  66
  67 sub excludes { confess "Mouse::Role does not currently support 'excludes'" }
  68
  69 sub import {
  70     my $class = shift;
  71
  72     strict->import;
  73     warnings->import;
  74
  75     my $caller = caller;
  76
  77     # we should never export to main
  78     if ($caller eq 'main') {
  79         warn qq{$class does not export its sugar to the 'main' package.\n};
  80         return;
  81     }
  82
  83     my $meta = Mouse::Meta::Role->initialize(caller);
  84
  85     no strict 'refs';
  86     no warnings 'redefine';
  87     *{$caller.'::meta'} = sub { $meta };
  88
  89     Mouse::Role->export_to_level(1, @_);
  90 }
  91
  92 sub unimport {
  93     my $caller = caller;
  94
  95     no strict 'refs';
  96     for my $keyword (@EXPORT) {
  97         delete ${ $caller . '::' }{$keyword};
  98     }
  99 }
 100
 101 1;
 102
 103 __END__
 104
 105 =head1 NAME
 106
 107 Mouse::Role - define a role in Mouse
 108
 109 =head1 KEYWORDS
 110
 111 =head2 meta -> Mouse::Meta::Role
 112
 113 Returns this role's metaclass instance.
 114
 115 =head2 before (method|methods) => Code
 116
 117 Sets up a "before" method modifier. See L<Moose/before> or
 118 L<Class::Method::Modifiers/before>.
 119
 120 =head2 after (method|methods) => Code
 121
 122 Sets up an "after" method modifier. See L<Moose/after> or
 123 L<Class::Method::Modifiers/after>.
 124
 125 =head2 around (method|methods) => Code
 126
 127 Sets up an "around" method modifier. See L<Moose/around> or
 128 L<Class::Method::Modifiers/around>.
 129
 130 =head2 has (name|names) => parameters
 131
 132 Sets up an attribute (or if passed an arrayref of names, multiple attributes) to
 133 this role. See L<Mouse/has>.
 134
 135 =head2 confess error -> BOOM
 136
 137 L<Carp/confess> for your convenience.
 138
 139 =head2 blessed value -> ClassName | undef
 140
 141 L<Scalar::Util/blessed> for your convenience.
 142
 143 =head1 MISC
 144
 145 =head2 import
 146
 147 Importing Mouse::Role will give you sugar.
 148
 149 =head2 unimport
 150
 151 Please unimport Mouse (C<no Mouse::Role>) so that if someone calls one of the
 152 keywords (such as L</has>) it will break loudly instead breaking subtly.
 153
 154 =cut
 155