lib/Mouse/Role.pm

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