Commit | Line | Data |
59fc9d16 |
1 | package CatalystX::DynamicComponent; |
53a42ae0 |
2 | use MooseX::Role::Parameterized; |
ac8aab7d |
3 | use MooseX::Types::Moose qw/Str CodeRef HashRef ArrayRef/; |
4 | use Catalyst::Utils; |
5 | use Moose::Util::TypeConstraints; |
6 | use List::MoreUtils qw/uniq/; |
046d763d |
7 | use namespace::autoclean; |
59fc9d16 |
8 | |
ac8aab7d |
9 | enum __PACKAGE__ . '::ResolveStrategy' => qw/ |
10 | merge |
11 | replace |
12 | /; |
13 | |
104abdae |
14 | our $VERSION = 0.000001; |
15 | |
53a42ae0 |
16 | parameter 'name' => ( |
0b07685c |
17 | isa => Str, |
53a42ae0 |
18 | required => 1, |
19 | ); |
20 | |
21 | parameter 'pre_immutable_hook' => ( |
92c28c42 |
22 | isa => CodeRef|Str, |
53a42ae0 |
23 | predicate => 'has_pre_immutable_hook', |
24 | ); |
25 | |
72b52242 |
26 | my $coerceablearray = subtype ArrayRef; |
27 | coerce $coerceablearray, from Str, via { [ $_ ] }; |
28 | |
ac8aab7d |
29 | my %parameters = ( |
30 | methods => { |
31 | isa =>HashRef, |
32 | default => sub { {} }, |
33 | resolve_strategy => 'merge', |
34 | }, |
35 | roles => { |
72b52242 |
36 | isa => $coerceablearray, coerce => 1, |
ac8aab7d |
37 | default => sub { [] }, |
38 | resolve_strategy => 'merge', |
39 | }, |
40 | superclasses => { |
72b52242 |
41 | isa => $coerceablearray, coerce => 1, |
ac8aab7d |
42 | default => sub { [] }, |
43 | resolve_strategy => 'replace', |
44 | }, |
45 | ); |
46 | |
47 | # Shameless metaprogramming. |
48 | foreach my $name (keys %parameters) { |
49 | my $resolve_strategy = delete $parameters{$name}->{resolve_strategy}; |
50 | |
51 | parameter $name, %{ $parameters{$name} }; |
52 | |
53 | parameter $name . '_resolve_strategy' => ( |
54 | isa => __PACKAGE__ . '::ResolveStrategy', |
55 | default => $resolve_strategy, |
56 | ); |
57 | } |
58 | |
59 | # Code refs to implement the strategy types |
60 | my %strategies = ( # Right hand precedence where appropriate |
72b52242 |
61 | replace => sub { |
62 | $_[0] = [ $_[0] ] if $_[0] && !ref $_[0]; |
63 | $_[1] = [ $_[1] ] if $_[1] && !ref $_[1]; |
64 | $_[1] ? $_[1] : $_[0]; |
65 | }, |
ac8aab7d |
66 | merge => sub { |
72b52242 |
67 | $_[0] = [ $_[0] ] if $_[0] && !ref $_[0]; |
68 | $_[1] = [ $_[1] ] if $_[1] && !ref $_[1]; |
69 | if (ref($_[0]) eq 'ARRAY' || ref($_[1]) eq 'ARRAY') { |
ac8aab7d |
70 | [ uniq( @{ $_[0] }, @{ $_[1] } ) ]; |
71 | } |
72 | else { |
73 | Catalyst::Utils::merge_hashes(shift, shift); |
74 | } |
75 | }, |
cd6bd40d |
76 | ); |
77 | |
ac8aab7d |
78 | # Wrap all the crazy up in a method to generically merge configs. |
79 | my $get_resolved_config = sub { |
80 | my ($name, $p, $config) = @_; |
81 | my $get_strategy_method_name = $name . '_resolve_strategy'; |
82 | my $strategy = $strategies{$p->$get_strategy_method_name()}; |
83 | $strategy->($p->$name, $config->{$name}) |
84 | || $parameters{$name}->{default}->(); |
85 | }; |
86 | |
53a42ae0 |
87 | role { |
88 | my $p = shift; |
89 | my $name = $p->name; |
cd6bd40d |
90 | my $pre_immutable_hook = $p->pre_immutable_hook; |
0b07685c |
91 | |
53a42ae0 |
92 | method $name => sub { |
c52d8688 |
93 | my ($app, $name, $config) = @_; |
62680454 |
94 | my $appclass = blessed($app) || $app; |
c52d8688 |
95 | |
96 | $config ||= {}; |
53a42ae0 |
97 | |
53a42ae0 |
98 | my $type = $name; |
53a42ae0 |
99 | $type =~ s/::.*$//; |
100 | |
62680454 |
101 | my $component_name = $appclass . '::' . $name; |
102 | my $meta = Moose->init_meta( for_class => $component_name ); |
279c014c |
103 | |
ac8aab7d |
104 | my @superclasses = @{ $get_resolved_config->('superclasses', $p, $config) }; |
0b07685c |
105 | push(@superclasses, 'Catalyst::' . $type) unless @superclasses; |
106 | $meta->superclasses(@superclasses); |
96e54fc3 |
107 | |
ac8aab7d |
108 | my $methods = $get_resolved_config->('methods', $p, $config); |
62680454 |
109 | foreach my $method_name (keys %$methods) { |
110 | $meta->add_method($method_name => $methods->{$method_name}); |
549d6abc |
111 | } |
741991f9 |
112 | |
113 | if (my @roles = @{ $get_resolved_config->('roles', $p, $config) }) { |
62680454 |
114 | Moose::Util::apply_all_roles( $component_name, @roles); |
741991f9 |
115 | } |
96e54fc3 |
116 | |
92c28c42 |
117 | if ($p->has_pre_immutable_hook) { |
118 | if (!ref($pre_immutable_hook)) { |
119 | $app->$pre_immutable_hook($meta, $config); |
120 | } |
121 | else { |
122 | $pre_immutable_hook->($meta, $config); |
123 | } |
124 | } |
125 | |
53a42ae0 |
126 | $meta->make_immutable; |
127 | |
62680454 |
128 | my $instance = $app->setup_component($component_name); |
129 | $app->components->{ $component_name } = $instance; |
53a42ae0 |
130 | }; |
131 | }; |
59fc9d16 |
132 | |
133 | 1; |
134 | |
dc7781e3 |
135 | __END__ |
136 | |
137 | =head1 NAME |
138 | |
139 | CatalystX::DynamicComponent - Parameterised Moose role providing functionality to build Catalyst components at runtime. |
140 | |
141 | =head1 SYNOPSIS |
142 | |
143 | package My::DynamicComponentType; |
144 | use Moose::Role; |
145 | use namespace::autoclean; |
146 | |
147 | with 'CatalystX::DynamicComponent' => { |
148 | name => '_setup_one_of_my_components', # Name of injected method |
149 | }; |
150 | |
151 | after setup_components => sub { shift->_setup_all_my_components(@_); }; |
152 | |
153 | sub _setup_all_my_components { |
154 | my ($self, $c) = @_; |
f29c6cde |
155 | my $app = ref($self) || $self; |
156 | foreach my $component_name ('Controller::Foo') { |
157 | my %component_config = %{ $c->config->{$component_name} }; |
158 | # Shallow copy so we avoid stuffing methods back in the config, as that's lame! |
159 | $component_config{methods} = { |
160 | some_method => sub { 'foo' }, |
161 | }; |
162 | |
dc7781e3 |
163 | # Calling this method creates a component, and registers it in your application |
f29c6cde |
164 | # This component will subclass 'MyApp::ControllerBase', do 'MyApp::ControllerRole' |
165 | # and have a method called 'some_method' which will return the value 'foo'.. |
166 | $self->_setup_one_of_my_components($app . '::' . $component_name, \%component_config); |
dc7781e3 |
167 | } |
168 | } |
169 | |
f29c6cde |
170 | package MyApp; |
171 | use Moose; |
172 | use namespace::autoclean; |
173 | use Catalyst qw/ |
174 | +My::DynameComponentType |
175 | /; |
176 | __PACKAGE__->config( |
177 | name => 'MyApp', |
178 | 'Controller::Foo' => { |
179 | superclasses => [qw/MyApp::ControllerBase/], |
180 | roles => [qw/MyApp::ControllerRole/], |
181 | }, |
182 | ); |
183 | __PACKAGE__->setup; |
184 | |
dc7781e3 |
185 | =head1 DESCRIPTION |
186 | |
f29c6cde |
187 | CatalystX::DynamicComponent aims to provide a flexible and reuseable method of building L<Roles|Moose::Role> |
188 | which can be added to L<Catalyst> applications, which generate components dynamically at application |
189 | startup using the L<Moose> meta model. |
dc7781e3 |
190 | |
f29c6cde |
191 | Thi is implemented as a parametrised role which curries a |
192 | component builder method into your current package at application time. |
dc7781e3 |
193 | |
f29c6cde |
194 | Authors of specific dynamic component builders are expected implement an application class |
195 | roles which composes this role, and their own advice after the C<< setup_compontents >> |
196 | method, which will call the component generation method provided by using this role once |
197 | for each component you wish to create. |
dc7781e3 |
198 | |
199 | =head1 PARAMETERS |
200 | |
201 | =head2 name |
202 | |
203 | B<Required> - The name of the component generator method to curry. |
204 | |
f29c6cde |
205 | =head2 methods |
dc7781e3 |
206 | |
f29c6cde |
207 | Optional, a hash reference with keys being method names, and values being a L<Class::MOP::Method>, |
208 | or a plain code ref of a method to apply to |
dc7781e3 |
209 | the dynamically generated package before making it immutable. |
210 | |
f29c6cde |
211 | =head2 roles |
212 | |
213 | Optional, an array reference of roles to apply to the generated component |
214 | |
215 | =head2 superclasses |
216 | |
217 | Optional, an array reference of superclasses to give the generated component. |
218 | |
219 | If this is not defined, and not passed in as an argument to the generation method, |
220 | then Catalyst::(Model|View|Controller) will used as the base class (as appropriate given |
221 | the requested namespace of the generated class, otherwise Catalyst::Component will be used. |
222 | |
223 | FIXME - Need tests for this. |
224 | |
dc7781e3 |
225 | =head2 pre_immutable_hook |
226 | |
f29c6cde |
227 | Optional, either a coderef, which will be called with the component $meta and the merged $config, |
228 | or a string name of a method to call on the application class, with the same parameters. |
229 | |
230 | This hook is called after a component has been generated and methods added, but before it is made |
231 | immutable, constructed, and added to your component registry. |
dc7781e3 |
232 | |
233 | =head1 CURRIED COMPONENT GENERATOR |
234 | |
235 | =head2 ARGUMENTS |
236 | |
237 | =over |
238 | |
6ba37fba |
239 | =item * |
240 | |
241 | $component_name (E.g. C<< MyApp::Controller::Foo >>) |
242 | |
243 | =item * |
244 | |
245 | $config (E.g. C<< $c->config->{$component_name} >>) |
dc7781e3 |
246 | |
6ba37fba |
247 | =back |
dc7781e3 |
248 | |
f29c6cde |
249 | =head3 config |
250 | |
251 | It is possible to set each of the roles, methods and superclasses parameters for each generated package |
252 | individually by defining those keys in the C< $config > parameter to your curried component generation method. |
253 | |
254 | By default, roles and methods supplied from the curried role, and those passed as config will be merged. |
255 | |
256 | Superclasses, no the other hand, will replace those from the curried configuration if passed as options. |
257 | This is to discourage accidental use of multiple inheritence, if you need this feature enabled, you should |
258 | probably be using Roles instead! |
259 | |
260 | It is possible to change the default behavior of each parameter by passing a |
261 | C< $param_name.'_resolve_strategy' > parameter when currying a class generator, with values of either |
262 | C<merge> or C<replace>. |
263 | |
264 | Example: |
265 | |
266 | package My::ComponentGenerator; |
267 | use Moose; |
268 | |
269 | with 'CatalystX::DynamicComponent' => { |
270 | name => 'generate_magic_component', |
271 | roles => ['My::Role'], |
272 | roles_resolve_strategy => 'replace', |
273 | }; |
274 | |
275 | package MyApp; |
276 | use Moose; |
277 | use Catalyst qw/ |
278 | My::ComponentGenerator |
279 | /; |
280 | extends 'Catalyst'; |
281 | after 'setup_components' => sub { |
282 | my ($app) = @_; |
283 | # Component generated has no roles |
284 | $app->generate_magic_component('MyApp::Controller::Foo', { roles => [] }); |
285 | # Component generated does My::Role |
286 | $app->generate_magic_component('MyApp::Controller::Foo', {} ); |
287 | }; |
288 | __PACKAGE__->setup; |
289 | |
dc7781e3 |
290 | =head2 OPERATION |
291 | |
292 | FIXME |
293 | |
294 | =head1 TODO |
295 | |
296 | =over |
297 | |
298 | =item * |
299 | |
f29c6cde |
300 | Test pre_immutable hook in tests |
dc7781e3 |
301 | |
302 | =item * |
303 | |
f29c6cde |
304 | More tests fixme? |
dc7781e3 |
305 | |
306 | =item * |
307 | |
f29c6cde |
308 | Unlame needing to pass fully qualified component name in, that's retarded... |
92c28c42 |
309 | |
f29c6cde |
310 | Remember to fix the docs and clients too ;) |
dc7781e3 |
311 | |
741991f9 |
312 | =item * |
313 | |
314 | Tests for roles giving advice to methods which have just been added.. |
315 | |
dc7781e3 |
316 | =back |
317 | |
f29c6cde |
318 | =head1 LINKS |
319 | |
320 | L<Catalyst>, L<MooseX::MethodAttributes>, L<CatalystX::ModelsFromConfig>. |
321 | |
dc7781e3 |
322 | =head1 BUGS |
323 | |
324 | Probably plenty, test suite certainly isn't comprehensive.. Patches welcome. |
325 | |
326 | =head1 AUTHOR |
327 | |
328 | Tomas Doran (t0m) <bobtfish@bobtfish.net> |
329 | |
330 | =head1 LICENSE |
331 | |
332 | This code is copyright (c) 2009 Tomas Doran. This code is licensed on the same terms as perl |
333 | itself. |
334 | |
335 | =cut |
336 | |