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