Commit | Line | Data |
f9e68395 |
1 | package Mouse::Role; |
2 | use strict; |
3 | use warnings; |
b32e8fb9 |
4 | use base 'Exporter'; |
f9e68395 |
5 | |
67199842 |
6 | use Carp 'confess', 'croak'; |
6c169c50 |
7 | use Scalar::Util 'blessed'; |
f9e68395 |
8 | |
a2227e71 |
9 | use Mouse::Meta::Role; |
10 | |
67199842 |
11 | our @EXPORT = qw(before after around super override inner augment has extends with requires excludes confess blessed); |
b32e8fb9 |
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); |
f9e68395 |
28 | } |
b32e8fb9 |
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 | |
67199842 |
40 | |
41 | sub super { |
42 | return unless $Mouse::SUPER_BODY; |
43 | $Mouse::SUPER_BODY->(@Mouse::SUPER_ARGS); |
44 | } |
45 | |
46 | sub override { |
47 | my $classname = caller; |
48 | my $meta = Mouse::Meta::Role->initialize($classname); |
49 | |
50 | my $name = shift; |
51 | my $code = shift; |
52 | my $fullname = "${classname}::${name}"; |
53 | |
54 | defined &$fullname |
55 | && confess "Cannot add an override of method '$fullname' " . |
56 | "because there is a local version of '$fullname'"; |
57 | |
58 | $meta->add_override_method_modifier($name => sub { |
59 | local $Mouse::SUPER_PACKAGE = shift; |
60 | local $Mouse::SUPER_BODY = shift; |
61 | local @Mouse::SUPER_ARGS = @_; |
62 | |
63 | $code->(@_); |
64 | }); |
65 | } |
66 | |
67 | # We keep the same errors messages as Moose::Role emits, here. |
68 | sub inner { |
69 | croak "Moose::Role cannot support 'inner'"; |
70 | } |
71 | |
72 | sub augment { |
73 | croak "Moose::Role cannot support 'augment'"; |
74 | } |
75 | |
b32e8fb9 |
76 | sub has { |
77 | my $meta = Mouse::Meta::Role->initialize(caller); |
78 | |
79 | my $name = shift; |
80 | my %opts = @_; |
81 | |
82 | $meta->add_attribute($name => \%opts); |
83 | } |
84 | |
33aaf11b |
85 | sub extends { confess "Roles do not currently support 'extends'" } |
b32e8fb9 |
86 | |
b1b81553 |
87 | sub with { |
88 | my $meta = Mouse::Meta::Role->initialize(caller); |
89 | my $role = shift; |
4aaa2ed6 |
90 | my $args = shift || {}; |
91 | confess "Mouse::Role only supports 'with' on individual roles at a time" if @_ || !ref $args; |
b1b81553 |
92 | |
93 | Mouse::load_class($role); |
4aaa2ed6 |
94 | $role->meta->apply($meta, %$args); |
b1b81553 |
95 | } |
b32e8fb9 |
96 | |
59089ec3 |
97 | sub requires { |
98 | my $meta = Mouse::Meta::Role->initialize(caller); |
99 | Carp::croak "Must specify at least one method" unless @_; |
100 | $meta->add_required_methods(@_); |
101 | } |
b32e8fb9 |
102 | |
2badb84a |
103 | sub excludes { confess "Mouse::Role does not currently support 'excludes'" } |
b32e8fb9 |
104 | |
105 | sub import { |
7daedfff |
106 | my $class = shift; |
107 | |
b32e8fb9 |
108 | strict->import; |
109 | warnings->import; |
110 | |
111 | my $caller = caller; |
7daedfff |
112 | |
113 | # we should never export to main |
114 | if ($caller eq 'main') { |
115 | warn qq{$class does not export its sugar to the 'main' package.\n}; |
116 | return; |
117 | } |
118 | |
b32e8fb9 |
119 | my $meta = Mouse::Meta::Role->initialize(caller); |
120 | |
121 | no strict 'refs'; |
122 | no warnings 'redefine'; |
123 | *{$caller.'::meta'} = sub { $meta }; |
124 | |
125 | Mouse::Role->export_to_level(1, @_); |
126 | } |
f9e68395 |
127 | |
b32e8fb9 |
128 | sub unimport { |
129 | my $caller = caller; |
e71d8033 |
130 | |
b32e8fb9 |
131 | no strict 'refs'; |
132 | for my $keyword (@EXPORT) { |
133 | delete ${ $caller . '::' }{$keyword}; |
f9e68395 |
134 | } |
b32e8fb9 |
135 | } |
f9e68395 |
136 | |
137 | 1; |
138 | |
cadd5b5e |
139 | __END__ |
140 | |
141 | =head1 NAME |
142 | |
137498b8 |
143 | Mouse::Role - define a role in Mouse |
cadd5b5e |
144 | |
145 | =head1 KEYWORDS |
146 | |
147 | =head2 meta -> Mouse::Meta::Role |
148 | |
149 | Returns this role's metaclass instance. |
150 | |
151 | =head2 before (method|methods) => Code |
152 | |
153 | Sets up a "before" method modifier. See L<Moose/before> or |
154 | L<Class::Method::Modifiers/before>. |
155 | |
156 | =head2 after (method|methods) => Code |
157 | |
158 | Sets up an "after" method modifier. See L<Moose/after> or |
159 | L<Class::Method::Modifiers/after>. |
160 | |
161 | =head2 around (method|methods) => Code |
162 | |
163 | Sets up an "around" method modifier. See L<Moose/around> or |
164 | L<Class::Method::Modifiers/around>. |
165 | |
67199842 |
166 | =item B<super> |
167 | |
168 | Sets up the "super" keyword. See L<Moose/super>. |
169 | |
170 | =item B<override ($name, &sub)> |
171 | |
172 | Sets up an "override" method modifier. See L<Moose/Role/override>. |
173 | |
174 | =item B<inner> |
175 | |
176 | This is not supported and emits an error. See L<Moose/Role>. |
177 | |
178 | =item B<augment ($name, &sub)> |
179 | |
180 | This is not supported and emits an error. See L<Moose/Role>. |
181 | |
cadd5b5e |
182 | =head2 has (name|names) => parameters |
183 | |
184 | Sets up an attribute (or if passed an arrayref of names, multiple attributes) to |
185 | this role. See L<Mouse/has>. |
186 | |
187 | =head2 confess error -> BOOM |
188 | |
189 | L<Carp/confess> for your convenience. |
190 | |
191 | =head2 blessed value -> ClassName | undef |
192 | |
193 | L<Scalar::Util/blessed> for your convenience. |
194 | |
195 | =head1 MISC |
196 | |
197 | =head2 import |
198 | |
199 | Importing Mouse::Role will give you sugar. |
200 | |
201 | =head2 unimport |
202 | |
203 | Please unimport Mouse (C<no Mouse::Role>) so that if someone calls one of the |
204 | keywords (such as L</has>) it will break loudly instead breaking subtly. |
205 | |
206 | =cut |
207 | |