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