Commit | Line | Data |
f9e68395 |
1 | package Mouse::Role; |
2 | use strict; |
3 | use warnings; |
b32e8fb9 |
4 | use base 'Exporter'; |
f9e68395 |
5 | |
6d28c5cf |
6 | use Carp 'confess'; |
6c169c50 |
7 | use Scalar::Util 'blessed'; |
f9e68395 |
8 | |
6d28c5cf |
9 | use Mouse::Util qw(load_class not_supported); |
10 | use Mouse (); |
a2227e71 |
11 | |
2cb8b713 |
12 | our @EXPORT = qw( |
13 | extends with |
14 | has |
15 | before after around |
16 | override super |
17 | augment inner |
18 | |
19 | requires excludes |
20 | |
21 | blessed confess |
22 | ); |
23 | |
3a63a2e7 |
24 | our %is_removable = map{ $_ => undef } @EXPORT; |
25 | delete $is_removable{confess}; |
26 | delete $is_removable{blessed}; |
b32e8fb9 |
27 | |
28 | sub before { |
8bc2760b |
29 | my $meta = Mouse::Meta::Role->initialize(scalar caller); |
b32e8fb9 |
30 | |
31 | my $code = pop; |
32 | for (@_) { |
33 | $meta->add_before_method_modifier($_ => $code); |
34 | } |
35 | } |
36 | |
37 | sub after { |
8bc2760b |
38 | my $meta = Mouse::Meta::Role->initialize(scalar caller); |
b32e8fb9 |
39 | |
40 | my $code = pop; |
41 | for (@_) { |
42 | $meta->add_after_method_modifier($_ => $code); |
f9e68395 |
43 | } |
b32e8fb9 |
44 | } |
45 | |
46 | sub around { |
8bc2760b |
47 | my $meta = Mouse::Meta::Role->initialize(scalar caller); |
b32e8fb9 |
48 | |
49 | my $code = pop; |
50 | for (@_) { |
51 | $meta->add_around_method_modifier($_ => $code); |
52 | } |
53 | } |
54 | |
67199842 |
55 | |
56 | sub super { |
57 | return unless $Mouse::SUPER_BODY; |
58 | $Mouse::SUPER_BODY->(@Mouse::SUPER_ARGS); |
59 | } |
60 | |
61 | sub override { |
62 | my $classname = caller; |
63 | my $meta = Mouse::Meta::Role->initialize($classname); |
64 | |
65 | my $name = shift; |
66 | my $code = shift; |
67 | my $fullname = "${classname}::${name}"; |
68 | |
69 | defined &$fullname |
6d28c5cf |
70 | && $meta->throw_error("Cannot add an override of method '$fullname' " |
71 | . "because there is a local version of '$fullname'"); |
67199842 |
72 | |
73 | $meta->add_override_method_modifier($name => sub { |
74 | local $Mouse::SUPER_PACKAGE = shift; |
75 | local $Mouse::SUPER_BODY = shift; |
76 | local @Mouse::SUPER_ARGS = @_; |
77 | |
78 | $code->(@_); |
79 | }); |
80 | } |
81 | |
82 | # We keep the same errors messages as Moose::Role emits, here. |
83 | sub inner { |
6d28c5cf |
84 | Carp::croak "Roles cannot support 'inner'"; |
67199842 |
85 | } |
86 | |
87 | sub augment { |
6d28c5cf |
88 | Carp::croak "Roles cannot support 'augment'"; |
67199842 |
89 | } |
90 | |
b32e8fb9 |
91 | sub has { |
8bc2760b |
92 | my $meta = Mouse::Meta::Role->initialize(scalar caller); |
b32e8fb9 |
93 | |
94 | my $name = shift; |
95 | my %opts = @_; |
96 | |
97 | $meta->add_attribute($name => \%opts); |
98 | } |
99 | |
6d28c5cf |
100 | sub extends { |
101 | Carp::croak "Roles do not support 'extends'" |
102 | } |
b32e8fb9 |
103 | |
b1b81553 |
104 | sub with { |
8bc2760b |
105 | my $meta = Mouse::Meta::Role->initialize(scalar caller); |
ff687069 |
106 | Mouse::Util::apply_all_roles($meta->name, @_); |
b1b81553 |
107 | } |
b32e8fb9 |
108 | |
59089ec3 |
109 | sub requires { |
8bc2760b |
110 | my $meta = Mouse::Meta::Role->initialize(scalar caller); |
6d28c5cf |
111 | $meta->throw_error("Must specify at least one method") unless @_; |
59089ec3 |
112 | $meta->add_required_methods(@_); |
113 | } |
b32e8fb9 |
114 | |
6d28c5cf |
115 | sub excludes { |
116 | not_supported; |
117 | } |
b32e8fb9 |
118 | |
119 | sub import { |
7daedfff |
120 | my $class = shift; |
121 | |
b32e8fb9 |
122 | strict->import; |
123 | warnings->import; |
124 | |
125 | my $caller = caller; |
7daedfff |
126 | |
127 | # we should never export to main |
128 | if ($caller eq 'main') { |
129 | warn qq{$class does not export its sugar to the 'main' package.\n}; |
130 | return; |
131 | } |
132 | |
3a63a2e7 |
133 | Mouse::Meta::Role->initialize($caller)->add_method(meta => sub { |
134 | return Mouse::Meta::Role->initialize(ref($_[0]) || $_[0]); |
135 | }); |
b32e8fb9 |
136 | |
137 | Mouse::Role->export_to_level(1, @_); |
138 | } |
f9e68395 |
139 | |
b32e8fb9 |
140 | sub unimport { |
141 | my $caller = caller; |
e71d8033 |
142 | |
3a63a2e7 |
143 | my $stash = do{ |
144 | no strict 'refs'; |
145 | \%{$caller . '::'} |
146 | }; |
147 | |
b32e8fb9 |
148 | for my $keyword (@EXPORT) { |
3a63a2e7 |
149 | my $code; |
150 | if(exists $is_removable{$keyword} |
151 | && ($code = $caller->can($keyword)) |
152 | && (Mouse::Util::get_code_info($code))[0] eq __PACKAGE__){ |
153 | |
154 | delete $stash->{$keyword}; |
155 | } |
f9e68395 |
156 | } |
3a63a2e7 |
157 | return; |
b32e8fb9 |
158 | } |
f9e68395 |
159 | |
160 | 1; |
161 | |
cadd5b5e |
162 | __END__ |
163 | |
164 | =head1 NAME |
165 | |
137498b8 |
166 | Mouse::Role - define a role in Mouse |
cadd5b5e |
167 | |
168 | =head1 KEYWORDS |
169 | |
170 | =head2 meta -> Mouse::Meta::Role |
171 | |
172 | Returns this role's metaclass instance. |
173 | |
174 | =head2 before (method|methods) => Code |
175 | |
176 | Sets up a "before" method modifier. See L<Moose/before> or |
177 | L<Class::Method::Modifiers/before>. |
178 | |
179 | =head2 after (method|methods) => Code |
180 | |
181 | Sets up an "after" method modifier. See L<Moose/after> or |
182 | L<Class::Method::Modifiers/after>. |
183 | |
184 | =head2 around (method|methods) => Code |
185 | |
186 | Sets up an "around" method modifier. See L<Moose/around> or |
187 | L<Class::Method::Modifiers/around>. |
188 | |
4e8817b8 |
189 | =over 4 |
190 | |
67199842 |
191 | =item B<super> |
192 | |
193 | Sets up the "super" keyword. See L<Moose/super>. |
194 | |
195 | =item B<override ($name, &sub)> |
196 | |
197 | Sets up an "override" method modifier. See L<Moose/Role/override>. |
198 | |
199 | =item B<inner> |
200 | |
201 | This is not supported and emits an error. See L<Moose/Role>. |
202 | |
203 | =item B<augment ($name, &sub)> |
204 | |
205 | This is not supported and emits an error. See L<Moose/Role>. |
206 | |
4e8817b8 |
207 | =back |
208 | |
cadd5b5e |
209 | =head2 has (name|names) => parameters |
210 | |
211 | Sets up an attribute (or if passed an arrayref of names, multiple attributes) to |
212 | this role. See L<Mouse/has>. |
213 | |
214 | =head2 confess error -> BOOM |
215 | |
216 | L<Carp/confess> for your convenience. |
217 | |
218 | =head2 blessed value -> ClassName | undef |
219 | |
220 | L<Scalar::Util/blessed> for your convenience. |
221 | |
222 | =head1 MISC |
223 | |
224 | =head2 import |
225 | |
226 | Importing Mouse::Role will give you sugar. |
227 | |
228 | =head2 unimport |
229 | |
230 | Please unimport Mouse (C<no Mouse::Role>) so that if someone calls one of the |
231 | keywords (such as L</has>) it will break loudly instead breaking subtly. |
232 | |
233 | =cut |
234 | |