Commit | Line | Data |
7b42fc96 |
1 | package MooseX::Role::Parameterized; |
7557429d |
2 | |
d9e02904 |
3 | # ABSTRACT: parameterized roles |
7557429d |
4 | |
fc4a95b6 |
5 | use Moose ( |
6 | extends => { -as => 'moose_extends' }, |
7557429d |
7 | around => { -as => 'moose_around' }, |
2293e5f1 |
8 | qw/confess blessed/, |
fc4a95b6 |
9 | ); |
10 | |
11 | use Carp 'croak'; |
7b42fc96 |
12 | use Moose::Role (); |
fc4a95b6 |
13 | moose_extends 'Moose::Exporter'; |
7b42fc96 |
14 | |
d93bd54d |
15 | use MooseX::Role::Parameterized::Meta::Role::Parameterizable; |
5b82ffb1 |
16 | |
a457ed60 |
17 | our $CURRENT_METACLASS; |
4534bdce |
18 | |
5b82ffb1 |
19 | __PACKAGE__->setup_import_methods( |
209e00d2 |
20 | with_caller => ['parameter', 'role', 'method'], |
7557429d |
21 | as_is => [ |
22 | 'has', 'with', 'extends', 'requires', 'excludes', 'augment', 'inner', |
23 | 'before', 'after', 'around', 'super', 'override', 'confess', |
24 | 'blessed', |
25 | ], |
19af6e75 |
26 | ); |
27 | |
28 | sub parameter { |
29 | my $caller = shift; |
bd3dd853 |
30 | my $names = shift; |
31 | |
32 | $names = [$names] if !ref($names); |
33 | |
34 | for my $name (@$names) { |
9a21e637 |
35 | Class::MOP::Class->initialize($caller)->add_parameter($name, @_); |
bd3dd853 |
36 | } |
19af6e75 |
37 | } |
7b42fc96 |
38 | |
5b82ffb1 |
39 | sub role { |
40 | my $caller = shift; |
41 | my $role_generator = shift; |
9a21e637 |
42 | Class::MOP::Class->initialize($caller)->role_generator($role_generator); |
5b82ffb1 |
43 | } |
44 | |
7b42fc96 |
45 | sub init_meta { |
46 | my $self = shift; |
47 | |
48 | return Moose::Role->init_meta(@_, |
d93bd54d |
49 | metaclass => 'MooseX::Role::Parameterized::Meta::Role::Parameterizable', |
7b42fc96 |
50 | ); |
51 | } |
52 | |
5b82ffb1 |
53 | # give role a (&) prototype |
03c4551d |
54 | moose_around _make_wrapper => sub { |
5b82ffb1 |
55 | my $orig = shift; |
56 | my ($self, $caller, $sub, $fq_name) = @_; |
57 | |
58 | if ($fq_name =~ /::role$/) { |
59 | return sub (&) { $sub->($caller, @_) }; |
60 | } |
61 | |
62 | return $orig->(@_); |
63 | }; |
64 | |
a457ed60 |
65 | sub has { |
66 | confess "has must be called within the role { ... } block." |
67 | unless $CURRENT_METACLASS; |
68 | |
209e00d2 |
69 | my $names = shift; |
a457ed60 |
70 | $names = [$names] if !ref($names); |
71 | |
72 | for my $name (@$names) { |
73 | $CURRENT_METACLASS->add_attribute($name, @_); |
74 | } |
75 | } |
76 | |
209e00d2 |
77 | sub method { |
78 | confess "method must be called within the role { ... } block." |
79 | unless $CURRENT_METACLASS; |
80 | |
81 | my $caller = shift; |
82 | my $name = shift; |
83 | my $body = shift; |
84 | |
31c69f88 |
85 | my $method = $CURRENT_METACLASS->method_metaclass->wrap( |
209e00d2 |
86 | package_name => $caller, |
87 | name => $name, |
88 | body => $body, |
89 | ); |
90 | |
91 | $CURRENT_METACLASS->add_method($name => $method); |
92 | } |
93 | |
03c4551d |
94 | sub before { |
95 | confess "before must be called within the role { ... } block." |
96 | unless $CURRENT_METACLASS; |
97 | |
98 | my $code = pop @_; |
99 | |
100 | for (@_) { |
101 | croak "Roles do not currently support " |
102 | . ref($_) |
103 | . " references for before method modifiers" |
104 | if ref $_; |
105 | $CURRENT_METACLASS->add_before_method_modifier($_, $code); |
106 | } |
107 | } |
108 | |
109 | sub after { |
110 | confess "after must be called within the role { ... } block." |
111 | unless $CURRENT_METACLASS; |
112 | |
113 | my $code = pop @_; |
114 | |
115 | for (@_) { |
116 | croak "Roles do not currently support " |
117 | . ref($_) |
118 | . " references for after method modifiers" |
119 | if ref $_; |
120 | $CURRENT_METACLASS->add_after_method_modifier($_, $code); |
121 | } |
122 | } |
123 | |
124 | sub around { |
125 | confess "around must be called within the role { ... } block." |
126 | unless $CURRENT_METACLASS; |
127 | |
128 | my $code = pop @_; |
129 | |
130 | for (@_) { |
131 | croak "Roles do not currently support " |
132 | . ref($_) |
133 | . " references for around method modifiers" |
134 | if ref $_; |
135 | $CURRENT_METACLASS->add_around_method_modifier($_, $code); |
136 | } |
137 | } |
138 | |
d55c8861 |
139 | sub with { |
140 | confess "with must be called within the role { ... } block." |
141 | unless $CURRENT_METACLASS; |
142 | Moose::Util::apply_all_roles($CURRENT_METACLASS, @_); |
143 | } |
144 | |
eac6d242 |
145 | sub requires { |
146 | confess "requires must be called within the role { ... } block." |
147 | unless $CURRENT_METACLASS; |
148 | croak "Must specify at least one method" unless @_; |
149 | $CURRENT_METACLASS->add_required_methods(@_); |
150 | } |
151 | |
fa627596 |
152 | sub excludes { |
153 | confess "excludes must be called within the role { ... } block." |
154 | unless $CURRENT_METACLASS; |
155 | croak "Must specify at least one role" unless @_; |
156 | $CURRENT_METACLASS->add_excluded_roles(@_); |
157 | } |
158 | |
20725a2d |
159 | # see Moose.pm for discussion |
160 | sub super { |
161 | return unless $Moose::SUPER_BODY; |
162 | $Moose::SUPER_BODY->(@Moose::SUPER_ARGS); |
163 | } |
164 | |
165 | sub override { |
166 | confess "override must be called within the role { ... } block." |
167 | unless $CURRENT_METACLASS; |
168 | |
169 | my ($name, $code) = @_; |
170 | $CURRENT_METACLASS->add_override_method_modifier($name, $code); |
171 | } |
172 | |
fc4a95b6 |
173 | sub extends { croak "Roles do not currently support 'extends'" } |
174 | |
175 | sub inner { croak "Roles cannot support 'inner'" } |
176 | |
177 | sub augment { croak "Roles cannot support 'augment'" } |
178 | |
7b42fc96 |
179 | 1; |
180 | |
a4ac31fa |
181 | __END__ |
182 | |
a4ac31fa |
183 | =head1 SYNOPSIS |
184 | |
185 | package MyRole::Counter; |
186 | use MooseX::Role::Parameterized; |
187 | |
188 | parameter name => ( |
189 | is => 'ro', |
190 | isa => 'Str', |
191 | required => 1, |
192 | ); |
193 | |
194 | role { |
195 | my $p = shift; |
196 | |
197 | my $name = $p->name; |
198 | |
199 | has $name => ( |
200 | is => 'rw', |
201 | isa => 'Int', |
202 | default => 0, |
203 | ); |
204 | |
205 | method "increment_$name" => sub { |
206 | my $self = shift; |
207 | $self->$name($self->$name + 1); |
208 | }; |
209 | |
210 | method "decrement_$name" => sub { |
211 | my $self = shift; |
212 | $self->$name($self->$name - 1); |
213 | }; |
214 | }; |
215 | |
216 | package MyGame::Tile; |
217 | use Moose; |
218 | |
219 | with 'MyRole::Counter' => { name => 'stepped_on' }; |
220 | |
221 | =head1 L<MooseX::Role::Parameterized::Tutorial> |
222 | |
223 | B<Stop!> If you're new here, please read |
224 | L<MooseX::Role::Parameterized::Tutorial>. |
225 | |
226 | =head1 DESCRIPTION |
227 | |
228 | Your parameterized role consists of two things: parameter declarations and a |
229 | C<role> block. |
230 | |
231 | Parameters are declared using the L</parameter> keyword which very much |
232 | resembles L<Moose/has>. You can use any option that L<Moose/has> accepts. |
233 | These parameters will get their values when the consuming class (or role) uses |
234 | L<Moose/with>. A parameter object will be constructed with these values, and |
235 | passed to the C<role> block. |
236 | |
237 | The C<role> block then uses the usual L<Moose::Role> keywords to build up a |
238 | role. You can shift off the parameter object to inspect what the consuming |
239 | class provided as parameters. You can use the parameters to make your role |
240 | customizable! |
241 | |
242 | There are many paths to parameterized roles (hopefully with a consistent enough |
243 | API); I believe this to be the easiest and most flexible implementation. |
244 | Coincidentally, Pugs has a very similar design (I'm not convinced that that is |
245 | a good thing yet). |
246 | |
247 | =head1 CAVEATS |
248 | |
249 | You must use this syntax to declare methods in the role block: |
250 | C<method NAME => sub { ... };>. This is due to a limitation in Perl. In return |
251 | though you can use parameters I<in your methods>! |
252 | |
9d029b3d |
253 | You must use all the keywords in the role block. If it turns out to be correct, |
254 | we'll compose the parameterizable role (everything outside the role block) with |
255 | the parameterized role (everything inside the role block). We throw an error if |
256 | you try to use a keyword outside of the role block, so don't worry about it for |
257 | now. |
258 | |
259 | L<Moose::Role/alias> and L<Moose::Role/excludes> are not yet supported. I'm |
260 | completely unsure of whether they should be handled by this module. Until we |
261 | figure out a plan, both declaring and providing a parameter named C<alias> or |
262 | C<excludes> is an error. |
a4ac31fa |
263 | |
264 | =head1 AUTHOR |
265 | |
266 | Shawn M Moore, C<< <sartak@bestpractical.com> >> |
267 | |
268 | =cut |
269 | |