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