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 | ||
1820fffe | 164 | Mouse::Role - The Mouse Role |
165 | ||
166 | =head1 SYNOPSIS | |
167 | ||
168 | package MyRole; | |
169 | use Mouse::Role; | |
cadd5b5e | 170 | |
171 | =head1 KEYWORDS | |
172 | ||
1820fffe | 173 | =head2 C<< meta -> Mouse::Meta::Role >> |
cadd5b5e | 174 | |
175 | Returns this role's metaclass instance. | |
176 | ||
1820fffe | 177 | =head2 C<< before (method|methods) -> CodeRef >> |
cadd5b5e | 178 | |
1820fffe | 179 | Sets up a B<before> method modifier. See L<Moose/before> or |
cadd5b5e | 180 | L<Class::Method::Modifiers/before>. |
181 | ||
1820fffe | 182 | =head2 C<< after (method|methods) => CodeRef >> |
cadd5b5e | 183 | |
1820fffe | 184 | Sets up an B<after> method modifier. See L<Moose/after> or |
cadd5b5e | 185 | L<Class::Method::Modifiers/after>. |
186 | ||
1820fffe | 187 | =head2 C<< around (method|methods) => CodeRef >> |
cadd5b5e | 188 | |
1820fffe | 189 | Sets up an B<around> method modifier. See L<Moose/around> or |
cadd5b5e | 190 | L<Class::Method::Modifiers/around>. |
191 | ||
1820fffe | 192 | =head2 C<super> |
67199842 | 193 | |
1820fffe | 194 | Sets up the B<super> keyword. See L<Moose/super>. |
67199842 | 195 | |
1820fffe | 196 | =head2 C<< override method => CodeRef >> |
67199842 | 197 | |
1820fffe | 198 | Sets up an B<override> method modifier. See L<Moose/Role/override>. |
67199842 | 199 | |
1820fffe | 200 | =head2 C<inner> |
67199842 | 201 | |
1820fffe | 202 | This is not supported in roles and emits an error. See L<Moose/Role>. |
67199842 | 203 | |
1820fffe | 204 | =head2 C<< augment method => CodeRef >> |
67199842 | 205 | |
1820fffe | 206 | This is not supported in roles and emits an error. See L<Moose/Role>. |
67199842 | 207 | |
1820fffe | 208 | =head2 C<< has (name|names) => parameters >> |
cadd5b5e | 209 | |
210 | Sets up an attribute (or if passed an arrayref of names, multiple attributes) to | |
211 | this role. See L<Mouse/has>. | |
212 | ||
1820fffe | 213 | =head2 C<< confess(error) -> BOOM >> |
cadd5b5e | 214 | |
215 | L<Carp/confess> for your convenience. | |
216 | ||
1820fffe | 217 | =head2 C<< blessed(value) -> ClassName | undef >> |
cadd5b5e | 218 | |
219 | L<Scalar::Util/blessed> for your convenience. | |
220 | ||
221 | =head1 MISC | |
222 | ||
223 | =head2 import | |
224 | ||
225 | Importing Mouse::Role will give you sugar. | |
226 | ||
227 | =head2 unimport | |
228 | ||
1820fffe | 229 | Please unimport (C<< no Mouse::Role >>) so that if someone calls one of the |
cadd5b5e | 230 | keywords (such as L</has>) it will break loudly instead breaking subtly. |
231 | ||
1820fffe | 232 | =head1 SEE ALSO |
233 | ||
234 | L<Moose::Role> | |
235 | ||
cadd5b5e | 236 | =cut |
237 |