Commit | Line | Data |
7b42fc96 |
1 | package MooseX::Role::Parameterized; |
fc4a95b6 |
2 | use Moose ( |
3 | extends => { -as => 'moose_extends' }, |
7557429d |
4 | around => { -as => 'moose_around' }, |
2293e5f1 |
5 | qw/confess blessed/, |
fc4a95b6 |
6 | ); |
767906ab |
7 | moose_extends 'Moose::Exporter'; |
fc4a95b6 |
8 | |
7b42fc96 |
9 | use Moose::Role (); |
7b42fc96 |
10 | |
d93bd54d |
11 | use MooseX::Role::Parameterized::Meta::Role::Parameterizable; |
5b82ffb1 |
12 | |
a457ed60 |
13 | our $CURRENT_METACLASS; |
4534bdce |
14 | |
5b82ffb1 |
15 | __PACKAGE__->setup_import_methods( |
ff2ccd89 |
16 | with_caller => ['parameter', 'role', 'method', 'has', 'with', 'extends', |
17 | 'requires', 'excludes', 'augment', 'inner', 'before', |
18 | 'after', 'around', 'super', 'override'], |
19 | as_is => [ 'confess', 'blessed' ], |
19af6e75 |
20 | ); |
21 | |
22 | sub parameter { |
23 | my $caller = shift; |
4f3cfe3f |
24 | |
25 | confess "'parameter' may not be used inside of the role block" |
26 | if $CURRENT_METACLASS; |
27 | |
82b8405c |
28 | my $meta = Class::MOP::class_of($caller); |
bd3dd853 |
29 | |
ff2ccd89 |
30 | my $names = shift; |
bd3dd853 |
31 | $names = [$names] if !ref($names); |
32 | |
33 | for my $name (@$names) { |
ff2ccd89 |
34 | $meta->add_parameter($name, @_); |
bd3dd853 |
35 | } |
19af6e75 |
36 | } |
7b42fc96 |
37 | |
e8e8ef39 |
38 | sub role (&) { |
5b82ffb1 |
39 | my $caller = shift; |
40 | my $role_generator = shift; |
82b8405c |
41 | Class::MOP::class_of($caller)->role_generator($role_generator); |
5b82ffb1 |
42 | } |
43 | |
7b42fc96 |
44 | sub init_meta { |
45 | my $self = shift; |
46 | |
47 | return Moose::Role->init_meta(@_, |
d93bd54d |
48 | metaclass => 'MooseX::Role::Parameterized::Meta::Role::Parameterizable', |
7b42fc96 |
49 | ); |
50 | } |
51 | |
a457ed60 |
52 | sub has { |
ff2ccd89 |
53 | my $caller = shift; |
82b8405c |
54 | my $meta = $CURRENT_METACLASS || Class::MOP::class_of($caller); |
a457ed60 |
55 | |
209e00d2 |
56 | my $names = shift; |
a457ed60 |
57 | $names = [$names] if !ref($names); |
58 | |
59 | for my $name (@$names) { |
ff2ccd89 |
60 | $meta->add_attribute($name, @_); |
a457ed60 |
61 | } |
62 | } |
63 | |
209e00d2 |
64 | sub method { |
209e00d2 |
65 | my $caller = shift; |
82b8405c |
66 | my $meta = $CURRENT_METACLASS || Class::MOP::class_of($caller); |
ff2ccd89 |
67 | |
209e00d2 |
68 | my $name = shift; |
69 | my $body = shift; |
70 | |
ff2ccd89 |
71 | my $method = $meta->method_metaclass->wrap( |
209e00d2 |
72 | package_name => $caller, |
73 | name => $name, |
74 | body => $body, |
75 | ); |
76 | |
ff2ccd89 |
77 | $meta->add_method($name => $method); |
209e00d2 |
78 | } |
79 | |
cbee2cbc |
80 | sub _add_method_modifier { |
81 | my $type = shift; |
ff2ccd89 |
82 | my $caller = shift; |
82b8405c |
83 | my $meta = $CURRENT_METACLASS || Class::MOP::class_of($caller); |
03c4551d |
84 | |
85 | my $code = pop @_; |
86 | |
87 | for (@_) { |
767906ab |
88 | Carp::croak "Roles do not currently support " |
03c4551d |
89 | . ref($_) |
cbee2cbc |
90 | . " references for $type method modifiers" |
03c4551d |
91 | if ref $_; |
cbee2cbc |
92 | |
93 | my $add_method = "add_${type}_method_modifier"; |
94 | $meta->$add_method($_, $code); |
03c4551d |
95 | } |
96 | } |
97 | |
cbee2cbc |
98 | sub before { |
99 | _add_method_modifier('before', @_); |
100 | } |
03c4551d |
101 | |
cbee2cbc |
102 | sub after { |
103 | _add_method_modifier('after', @_); |
03c4551d |
104 | } |
105 | |
106 | sub around { |
cbee2cbc |
107 | _add_method_modifier('around', @_); |
03c4551d |
108 | } |
109 | |
d55c8861 |
110 | sub with { |
ff2ccd89 |
111 | my $caller = shift; |
82b8405c |
112 | my $meta = $CURRENT_METACLASS || Class::MOP::class_of($caller); |
ff2ccd89 |
113 | |
114 | Moose::Util::apply_all_roles($meta, @_); |
d55c8861 |
115 | } |
116 | |
eac6d242 |
117 | sub requires { |
ff2ccd89 |
118 | my $caller = shift; |
82b8405c |
119 | my $meta = $CURRENT_METACLASS || Class::MOP::class_of($caller); |
ff2ccd89 |
120 | |
767906ab |
121 | Carp::croak "Must specify at least one method" unless @_; |
ff2ccd89 |
122 | $meta->add_required_methods(@_); |
eac6d242 |
123 | } |
124 | |
fa627596 |
125 | sub excludes { |
ff2ccd89 |
126 | my $caller = shift; |
82b8405c |
127 | my $meta = $CURRENT_METACLASS || Class::MOP::class_of($caller); |
ff2ccd89 |
128 | |
767906ab |
129 | Carp::croak "Must specify at least one role" unless @_; |
ff2ccd89 |
130 | $meta->add_excluded_roles(@_); |
fa627596 |
131 | } |
132 | |
20725a2d |
133 | # see Moose.pm for discussion |
134 | sub super { |
135 | return unless $Moose::SUPER_BODY; |
136 | $Moose::SUPER_BODY->(@Moose::SUPER_ARGS); |
137 | } |
138 | |
139 | sub override { |
ff2ccd89 |
140 | my $caller = shift; |
82b8405c |
141 | my $meta = $CURRENT_METACLASS || Class::MOP::class_of($caller); |
20725a2d |
142 | |
143 | my ($name, $code) = @_; |
ff2ccd89 |
144 | $meta->add_override_method_modifier($name, $code); |
20725a2d |
145 | } |
146 | |
767906ab |
147 | sub extends { Carp::croak "Roles do not currently support 'extends'" } |
fc4a95b6 |
148 | |
767906ab |
149 | sub inner { Carp::croak "Roles cannot support 'inner'" } |
fc4a95b6 |
150 | |
767906ab |
151 | sub augment { Carp::croak "Roles cannot support 'augment'" } |
fc4a95b6 |
152 | |
7b42fc96 |
153 | 1; |
154 | |
a4ac31fa |
155 | __END__ |
156 | |
30788701 |
157 | =head1 NAME |
158 | |
159 | MooseX::Role::Parameterized - parameterized roles |
160 | |
a4ac31fa |
161 | =head1 SYNOPSIS |
162 | |
163 | package MyRole::Counter; |
164 | use MooseX::Role::Parameterized; |
165 | |
166 | parameter name => ( |
a4ac31fa |
167 | isa => 'Str', |
168 | required => 1, |
169 | ); |
170 | |
171 | role { |
172 | my $p = shift; |
173 | |
174 | my $name = $p->name; |
175 | |
176 | has $name => ( |
177 | is => 'rw', |
178 | isa => 'Int', |
179 | default => 0, |
180 | ); |
181 | |
182 | method "increment_$name" => sub { |
183 | my $self = shift; |
184 | $self->$name($self->$name + 1); |
185 | }; |
186 | |
187 | method "decrement_$name" => sub { |
188 | my $self = shift; |
189 | $self->$name($self->$name - 1); |
190 | }; |
191 | }; |
192 | |
193 | package MyGame::Tile; |
194 | use Moose; |
195 | |
196 | with 'MyRole::Counter' => { name => 'stepped_on' }; |
197 | |
198 | =head1 L<MooseX::Role::Parameterized::Tutorial> |
199 | |
200 | B<Stop!> If you're new here, please read |
4f56fe52 |
201 | L<MooseX::Role::Parameterized::Tutorial> for a much gentler introduction. |
a4ac31fa |
202 | |
203 | =head1 DESCRIPTION |
204 | |
aeaaabaf |
205 | Your parameterized role consists of two new things: parameter declarations |
206 | and a C<role> block. |
a4ac31fa |
207 | |
208 | Parameters are declared using the L</parameter> keyword which very much |
fa2e6c00 |
209 | resembles L<Moose/has>. You can use any option that L<Moose/has> accepts. The |
aeaaabaf |
210 | default value for the C<is> option is C<ro> as that's a very common case. These |
fa2e6c00 |
211 | parameters will get their values when the consuming class (or role) uses |
a4ac31fa |
212 | L<Moose/with>. A parameter object will be constructed with these values, and |
213 | passed to the C<role> block. |
214 | |
215 | The C<role> block then uses the usual L<Moose::Role> keywords to build up a |
216 | role. You can shift off the parameter object to inspect what the consuming |
aeaaabaf |
217 | class provided as parameters. You use the parameters to customize your |
218 | role however you wish. |
a4ac31fa |
219 | |
aeaaabaf |
220 | There are many possible implementations for parameterized roles (hopefully with |
221 | a consistent enough API); I believe this to be the easiest and most flexible |
70afb58d |
222 | design. Coincidentally, Pugs originally had an eerily similar design. |
223 | |
224 | =head2 Why a parameters object? |
225 | |
226 | I've been asked several times "Why use a parameter I<object> and not just a |
227 | parameter I<hashref>? That would eliminate the need to explicitly declare your |
228 | parameters." |
229 | |
230 | The benefits of using an object are similar to the benefits of using Moose. You |
231 | get an easy way to specify lazy defaults, type constraint, delegation, and so |
232 | on. You get to use MooseX modules. |
233 | |
234 | You also get the usual introspective and intercessory abilities that come |
235 | standard with the metaobject protocol. Ambitious users should be able to add |
236 | traits to the parameters metaclass to further customize behavior. Please let |
237 | me know if you're doing anything viciously complicated with this extension. :) |
a4ac31fa |
238 | |
239 | =head1 CAVEATS |
240 | |
241 | You must use this syntax to declare methods in the role block: |
08609551 |
242 | C<< method NAME => sub { ... }; >>. This is due to a limitation in Perl. In |
243 | return though you can use parameters I<in your methods>! |
a4ac31fa |
244 | |
9d029b3d |
245 | L<Moose::Role/alias> and L<Moose::Role/excludes> are not yet supported. I'm |
246 | completely unsure of whether they should be handled by this module. Until we |
aeaaabaf |
247 | figure out a plan, either declaring or providing a parameter named C<alias> or |
9d029b3d |
248 | C<excludes> is an error. |
a4ac31fa |
249 | |
250 | =head1 AUTHOR |
251 | |
252 | Shawn M Moore, C<< <sartak@bestpractical.com> >> |
253 | |
d5487cd9 |
254 | =head1 EXAMPLES |
988cddaa |
255 | |
d5487cd9 |
256 | =over 4 |
257 | |
258 | =item L<MooseX::Role::Matcher> |
259 | |
d5487cd9 |
260 | =item L<MooseX::Role::XMLRPC::Client> |
261 | |
bfac2339 |
262 | =item L<MooseX::RelatedClassRoles> |
263 | |
d5487cd9 |
264 | =item L<WWW::Mechanize::TreeBuilder> |
265 | |
c06f85c8 |
266 | =item L<NetHack::Item::Role::IncorporatesStats> |
267 | |
d5487cd9 |
268 | =item L<TAEB::Action::Role::Item> |
269 | |
270 | =item L<KiokuDB::Role::Scan> |
271 | |
272 | =item L<Fey::Role::MakesAliasObjects> |
273 | |
274 | =item L<Fey::Role::HasAliasName> |
275 | |
276 | =item L<Fey::Role::SetOperation> |
277 | |
278 | =back |
988cddaa |
279 | |
db96b944 |
280 | =head1 SEE ALSO |
281 | |
282 | L<http://sartak.blogspot.com/2009/05/parameterized-roles.html> |
283 | |
a4ac31fa |
284 | =cut |
285 | |