Mouse::Role supports 'with'
[gitmo/Mouse.git] / lib / Mouse / Role.pm
CommitLineData
f9e68395 1#!/usr/bin/env perl
2package Mouse::Role;
3use strict;
4use warnings;
b32e8fb9 5use base 'Exporter';
f9e68395 6
8da998d9 7use Carp 'confess';
8fcbe7fb 8use Mouse::Util 'blessed';
f9e68395 9
a2227e71 10use Mouse::Meta::Role;
11
b32e8fb9 12our @EXPORT = qw(before after around has extends with requires excludes confess blessed);
13
14sub 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
23sub after {
24 my $meta = Mouse::Meta::Role->initialize(caller);
25
26 my $code = pop;
27 for (@_) {
28 $meta->add_after_method_modifier($_ => $code);
f9e68395 29 }
b32e8fb9 30}
31
32sub 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
41sub 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
50sub extends { confess "Roles do not support 'extends'" }
51
b1b81553 52sub with {
53 my $meta = Mouse::Meta::Role->initialize(caller);
54 my $role = shift;
55 confess "Mouse::Role only supports 'with' on individual roles at a time" if @_;
56
57 Mouse::load_class($role);
58 $role->meta->apply($meta);
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