Skip squirrel tests when munging s/Mouse/Moose/
[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 {
70 strict->import;
71 warnings->import;
72
73 my $caller = caller;
74 my $meta = Mouse::Meta::Role->initialize(caller);
75
76 no strict 'refs';
77 no warnings 'redefine';
78 *{$caller.'::meta'} = sub { $meta };
79
80 Mouse::Role->export_to_level(1, @_);
81}
f9e68395 82
b32e8fb9 83sub unimport {
84 my $caller = caller;
e71d8033 85
b32e8fb9 86 no strict 'refs';
87 for my $keyword (@EXPORT) {
88 delete ${ $caller . '::' }{$keyword};
f9e68395 89 }
b32e8fb9 90}
f9e68395 91
921;
93
cadd5b5e 94__END__
95
96=head1 NAME
97
98Mouse::Role
99
100=head1 KEYWORDS
101
102=head2 meta -> Mouse::Meta::Role
103
104Returns this role's metaclass instance.
105
106=head2 before (method|methods) => Code
107
108Sets up a "before" method modifier. See L<Moose/before> or
109L<Class::Method::Modifiers/before>.
110
111=head2 after (method|methods) => Code
112
113Sets up an "after" method modifier. See L<Moose/after> or
114L<Class::Method::Modifiers/after>.
115
116=head2 around (method|methods) => Code
117
118Sets up an "around" method modifier. See L<Moose/around> or
119L<Class::Method::Modifiers/around>.
120
121=head2 has (name|names) => parameters
122
123Sets up an attribute (or if passed an arrayref of names, multiple attributes) to
124this role. See L<Mouse/has>.
125
126=head2 confess error -> BOOM
127
128L<Carp/confess> for your convenience.
129
130=head2 blessed value -> ClassName | undef
131
132L<Scalar::Util/blessed> for your convenience.
133
134=head1 MISC
135
136=head2 import
137
138Importing Mouse::Role will give you sugar.
139
140=head2 unimport
141
142Please unimport Mouse (C<no Mouse::Role>) so that if someone calls one of the
143keywords (such as L</has>) it will break loudly instead breaking subtly.
144
145=cut
146