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