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 | my $name = shift; |
b32e8fb9 | 94 | |
1b9e472d | 95 | $meta->add_attribute($_ => @_) for ref($name) ? @{$name} : $name; |
b32e8fb9 | 96 | } |
97 | ||
6d28c5cf | 98 | sub extends { |
99 | Carp::croak "Roles do not support 'extends'" | |
100 | } | |
b32e8fb9 | 101 | |
b1b81553 | 102 | sub with { |
8bc2760b | 103 | my $meta = Mouse::Meta::Role->initialize(scalar caller); |
ff687069 | 104 | Mouse::Util::apply_all_roles($meta->name, @_); |
b1b81553 | 105 | } |
b32e8fb9 | 106 | |
59089ec3 | 107 | sub requires { |
8bc2760b | 108 | my $meta = Mouse::Meta::Role->initialize(scalar caller); |
6d28c5cf | 109 | $meta->throw_error("Must specify at least one method") unless @_; |
59089ec3 | 110 | $meta->add_required_methods(@_); |
111 | } | |
b32e8fb9 | 112 | |
6d28c5cf | 113 | sub excludes { |
114 | not_supported; | |
115 | } | |
b32e8fb9 | 116 | |
117 | sub import { | |
7daedfff | 118 | my $class = shift; |
119 | ||
b32e8fb9 | 120 | strict->import; |
121 | warnings->import; | |
122 | ||
123 | my $caller = caller; | |
7daedfff | 124 | |
125 | # we should never export to main | |
126 | if ($caller eq 'main') { | |
127 | warn qq{$class does not export its sugar to the 'main' package.\n}; | |
128 | return; | |
129 | } | |
130 | ||
3a63a2e7 | 131 | Mouse::Meta::Role->initialize($caller)->add_method(meta => sub { |
132 | return Mouse::Meta::Role->initialize(ref($_[0]) || $_[0]); | |
133 | }); | |
b32e8fb9 | 134 | |
135 | Mouse::Role->export_to_level(1, @_); | |
136 | } | |
f9e68395 | 137 | |
b32e8fb9 | 138 | sub unimport { |
139 | my $caller = caller; | |
e71d8033 | 140 | |
3a63a2e7 | 141 | my $stash = do{ |
142 | no strict 'refs'; | |
143 | \%{$caller . '::'} | |
144 | }; | |
145 | ||
b32e8fb9 | 146 | for my $keyword (@EXPORT) { |
3a63a2e7 | 147 | my $code; |
148 | if(exists $is_removable{$keyword} | |
149 | && ($code = $caller->can($keyword)) | |
150 | && (Mouse::Util::get_code_info($code))[0] eq __PACKAGE__){ | |
151 | ||
152 | delete $stash->{$keyword}; | |
153 | } | |
f9e68395 | 154 | } |
3a63a2e7 | 155 | return; |
b32e8fb9 | 156 | } |
f9e68395 | 157 | |
158 | 1; | |
159 | ||
cadd5b5e | 160 | __END__ |
161 | ||
162 | =head1 NAME | |
163 | ||
137498b8 | 164 | Mouse::Role - define a role in Mouse |
cadd5b5e | 165 | |
166 | =head1 KEYWORDS | |
167 | ||
168 | =head2 meta -> Mouse::Meta::Role | |
169 | ||
170 | Returns this role's metaclass instance. | |
171 | ||
172 | =head2 before (method|methods) => Code | |
173 | ||
174 | Sets up a "before" method modifier. See L<Moose/before> or | |
175 | L<Class::Method::Modifiers/before>. | |
176 | ||
177 | =head2 after (method|methods) => Code | |
178 | ||
179 | Sets up an "after" method modifier. See L<Moose/after> or | |
180 | L<Class::Method::Modifiers/after>. | |
181 | ||
182 | =head2 around (method|methods) => Code | |
183 | ||
184 | Sets up an "around" method modifier. See L<Moose/around> or | |
185 | L<Class::Method::Modifiers/around>. | |
186 | ||
4e8817b8 | 187 | =over 4 |
188 | ||
67199842 | 189 | =item B<super> |
190 | ||
191 | Sets up the "super" keyword. See L<Moose/super>. | |
192 | ||
193 | =item B<override ($name, &sub)> | |
194 | ||
195 | Sets up an "override" method modifier. See L<Moose/Role/override>. | |
196 | ||
197 | =item B<inner> | |
198 | ||
199 | This is not supported and emits an error. See L<Moose/Role>. | |
200 | ||
201 | =item B<augment ($name, &sub)> | |
202 | ||
203 | This is not supported and emits an error. See L<Moose/Role>. | |
204 | ||
4e8817b8 | 205 | =back |
206 | ||
cadd5b5e | 207 | =head2 has (name|names) => parameters |
208 | ||
209 | Sets up an attribute (or if passed an arrayref of names, multiple attributes) to | |
210 | this role. See L<Mouse/has>. | |
211 | ||
212 | =head2 confess error -> BOOM | |
213 | ||
214 | L<Carp/confess> for your convenience. | |
215 | ||
216 | =head2 blessed value -> ClassName | undef | |
217 | ||
218 | L<Scalar::Util/blessed> for your convenience. | |
219 | ||
220 | =head1 MISC | |
221 | ||
222 | =head2 import | |
223 | ||
224 | Importing Mouse::Role will give you sugar. | |
225 | ||
226 | =head2 unimport | |
227 | ||
228 | Please unimport Mouse (C<no Mouse::Role>) so that if someone calls one of the | |
229 | keywords (such as L</has>) it will break loudly instead breaking subtly. | |
230 | ||
231 | =cut | |
232 |