Throw a more useful error when users try to use a parameterized type,
[gitmo/Mouse.git] / lib / Mouse / Role.pm
CommitLineData
f9e68395 1package Mouse::Role;
2use strict;
3use warnings;
b32e8fb9 4use base 'Exporter';
f9e68395 5
8da998d9 6use Carp 'confess';
6c169c50 7use Scalar::Util 'blessed';
f9e68395 8
a2227e71 9use Mouse::Meta::Role;
10
b32e8fb9 11our @EXPORT = qw(before after around has extends with requires excludes confess blessed);
12
13sub 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
22sub after {
23 my $meta = Mouse::Meta::Role->initialize(caller);
24
25 my $code = pop;
26 for (@_) {
27 $meta->add_after_method_modifier($_ => $code);
f9e68395 28 }
b32e8fb9 29}
30
31sub 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
40sub 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
49sub extends { confess "Roles do not support 'extends'" }
50
b1b81553 51sub with {
52 my $meta = Mouse::Meta::Role->initialize(caller);
53 my $role = shift;
4aaa2ed6 54 my $args = shift || {};
55 confess "Mouse::Role only supports 'with' on individual roles at a time" if @_ || !ref $args;
b1b81553 56
57 Mouse::load_class($role);
4aaa2ed6 58 $role->meta->apply($meta, %$args);
b1b81553 59}
b32e8fb9 60
59089ec3 61sub 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}
b32e8fb9 66
2badb84a 67sub excludes { confess "Mouse::Role does not currently support 'excludes'" }
b32e8fb9 68
69sub import {
7daedfff 70 my $class = shift;
71
b32e8fb9 72 strict->import;
73 warnings->import;
74
75 my $caller = caller;
7daedfff 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
b32e8fb9 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}
f9e68395 91
b32e8fb9 92sub unimport {
93 my $caller = caller;
e71d8033 94
b32e8fb9 95 no strict 'refs';
96 for my $keyword (@EXPORT) {
97 delete ${ $caller . '::' }{$keyword};
f9e68395 98 }
b32e8fb9 99}
f9e68395 100
1011;
102
cadd5b5e 103__END__
104
105=head1 NAME
106
137498b8 107Mouse::Role - define a role in Mouse
cadd5b5e 108
109=head1 KEYWORDS
110
111=head2 meta -> Mouse::Meta::Role
112
113Returns this role's metaclass instance.
114
115=head2 before (method|methods) => Code
116
117Sets up a "before" method modifier. See L<Moose/before> or
118L<Class::Method::Modifiers/before>.
119
120=head2 after (method|methods) => Code
121
122Sets up an "after" method modifier. See L<Moose/after> or
123L<Class::Method::Modifiers/after>.
124
125=head2 around (method|methods) => Code
126
127Sets up an "around" method modifier. See L<Moose/around> or
128L<Class::Method::Modifiers/around>.
129
130=head2 has (name|names) => parameters
131
132Sets up an attribute (or if passed an arrayref of names, multiple attributes) to
133this role. See L<Mouse/has>.
134
135=head2 confess error -> BOOM
136
137L<Carp/confess> for your convenience.
138
139=head2 blessed value -> ClassName | undef
140
141L<Scalar::Util/blessed> for your convenience.
142
143=head1 MISC
144
145=head2 import
146
147Importing Mouse::Role will give you sugar.
148
149=head2 unimport
150
151Please unimport Mouse (C<no Mouse::Role>) so that if someone calls one of the
152keywords (such as L</has>) it will break loudly instead breaking subtly.
153
154=cut
155