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' => ( |
0b07685c |
22 | isa => Str, |
53a42ae0 |
23 | predicate => 'has_pre_immutable_hook', |
24 | ); |
25 | |
ac8aab7d |
26 | my %parameters = ( |
27 | methods => { |
28 | isa =>HashRef, |
29 | default => sub { {} }, |
30 | resolve_strategy => 'merge', |
31 | }, |
32 | roles => { |
33 | isa => ArrayRef, |
34 | default => sub { [] }, |
35 | resolve_strategy => 'merge', |
36 | }, |
37 | superclasses => { |
38 | isa => ArrayRef, |
39 | default => sub { [] }, |
40 | resolve_strategy => 'replace', |
41 | }, |
42 | ); |
43 | |
44 | # Shameless metaprogramming. |
45 | foreach my $name (keys %parameters) { |
46 | my $resolve_strategy = delete $parameters{$name}->{resolve_strategy}; |
47 | |
48 | parameter $name, %{ $parameters{$name} }; |
49 | |
50 | parameter $name . '_resolve_strategy' => ( |
51 | isa => __PACKAGE__ . '::ResolveStrategy', |
52 | default => $resolve_strategy, |
53 | ); |
54 | } |
55 | |
56 | # Code refs to implement the strategy types |
57 | my %strategies = ( # Right hand precedence where appropriate |
58 | replace => sub { $_[1]; }, |
59 | merge => sub { |
60 | if (ref($_[0]) eq 'ARRAY') { |
61 | [ uniq( @{ $_[0] }, @{ $_[1] } ) ]; |
62 | } |
63 | else { |
64 | Catalyst::Utils::merge_hashes(shift, shift); |
65 | } |
66 | }, |
cd6bd40d |
67 | ); |
68 | |
ac8aab7d |
69 | # Wrap all the crazy up in a method to generically merge configs. |
70 | my $get_resolved_config = sub { |
71 | my ($name, $p, $config) = @_; |
72 | my $get_strategy_method_name = $name . '_resolve_strategy'; |
73 | my $strategy = $strategies{$p->$get_strategy_method_name()}; |
74 | $strategy->($p->$name, $config->{$name}) |
75 | || $parameters{$name}->{default}->(); |
76 | }; |
77 | |
53a42ae0 |
78 | role { |
79 | my $p = shift; |
80 | my $name = $p->name; |
cd6bd40d |
81 | my $pre_immutable_hook = $p->pre_immutable_hook; |
0b07685c |
82 | |
53a42ae0 |
83 | method $name => sub { |
c52d8688 |
84 | my ($app, $name, $config) = @_; |
85 | |
86 | $config ||= {}; |
53a42ae0 |
87 | |
88 | my $appclass = blessed($app) || $app; |
89 | my $type = $name; |
90 | $type =~ s/^${appclass}:://; # FIXME - I think there is shit in C::Utils to do this. |
91 | $type =~ s/::.*$//; |
92 | |
93 | my $meta = Moose->init_meta( for_class => $name ); |
279c014c |
94 | |
ac8aab7d |
95 | my @superclasses = @{ $get_resolved_config->('superclasses', $p, $config) }; |
0b07685c |
96 | push(@superclasses, 'Catalyst::' . $type) unless @superclasses; |
97 | $meta->superclasses(@superclasses); |
98 | |
ac8aab7d |
99 | if (my @roles = @{ $get_resolved_config->('roles', $p, $config) }) { |
279c014c |
100 | Moose::Util::apply_all_roles( $name, @roles); |
101 | } |
00b934f1 |
102 | |
cd6bd40d |
103 | $app->$pre_immutable_hook($meta) if $p->has_pre_immutable_hook; |
00b934f1 |
104 | |
ac8aab7d |
105 | my $methods = $get_resolved_config->('methods', $p, $config); |
106 | foreach my $name (keys %$methods) { |
107 | $meta->add_method($name => $methods->{$name}); |
549d6abc |
108 | } |
53a42ae0 |
109 | $meta->make_immutable; |
110 | |
111 | my $instance = $app->setup_component($name); |
112 | $app->components->{ $name } = $instance; |
113 | }; |
114 | }; |
59fc9d16 |
115 | |
116 | 1; |
117 | |
dc7781e3 |
118 | __END__ |
119 | |
120 | =head1 NAME |
121 | |
122 | CatalystX::DynamicComponent - Parameterised Moose role providing functionality to build Catalyst components at runtime. |
123 | |
124 | =head1 SYNOPSIS |
125 | |
126 | package My::DynamicComponentType; |
127 | use Moose::Role; |
128 | use namespace::autoclean; |
129 | |
130 | with 'CatalystX::DynamicComponent' => { |
131 | name => '_setup_one_of_my_components', # Name of injected method |
132 | }; |
133 | |
134 | after setup_components => sub { shift->_setup_all_my_components(@_); }; |
135 | |
136 | sub _setup_all_my_components { |
137 | my ($self, $c) = @_; |
138 | foreach my $component_name ('MyApp::Component1') { |
139 | my $component_config = $c->config->{$component_name}; |
140 | # Calling this method creates a component, and registers it in your application |
141 | $self->_setup_one_of_my_components($component_name, $component_config); |
142 | } |
143 | } |
144 | |
145 | =head1 DESCRIPTION |
146 | |
147 | CatalystX::DynamicComponent aims to provide a flexible and reuseable method of building generic |
148 | Catalyst components and registering them with your application. |
149 | |
150 | To give you this flexibility, it is implemented as a parametrised role which curries a |
151 | component builder into your current package at application time. |
152 | |
153 | Authors of specific dynamic component builders are expected to be implemented as application class |
154 | roles which compose this role, but provide their own advice around the C<< setup_compontens >> |
155 | method, and call the curried method from this role once for each component you wish to setup. |
156 | |
157 | =head1 PARAMETERS |
158 | |
159 | =head2 name |
160 | |
161 | B<Required> - The name of the component generator method to curry. |
162 | |
163 | =head2 COMPONENT |
164 | |
165 | Optional, either a L<Class::MOP::Method>, or a plain code ref of a COMPONENT method to apply to |
166 | the dynamically generated package before making it immutable. |
167 | |
168 | =head2 pre_immutable_hook |
169 | |
170 | Optional, method to call after a component has been generated, but before it is made immutable, |
171 | constructed, and added to your component registry. |
172 | |
173 | =head1 CURRIED COMPONENT GENERATOR |
174 | |
175 | =head2 ARGUMENTS |
176 | |
177 | =over |
178 | |
179 | =item $component_name (E.g. C<< MyApp::Controller::Foo >>) |
180 | |
181 | =item $config (E.g. C<< $c->config->{$component_name} >>) |
182 | |
183 | =head2 OPERATION |
184 | |
185 | FIXME |
186 | |
187 | =head1 TODO |
188 | |
189 | =over |
190 | |
191 | =item * |
192 | |
193 | Better default handling of config - by default component should get config from where it normally |
194 | does! |
195 | |
196 | =item * |
197 | |
198 | Abstract handling of role application / class name. This should not just be the component config |
199 | by default. |
200 | |
201 | =item * |
202 | |
203 | Have some actual tests which test just this crap, and not all the other classes together. |
204 | |
205 | =back |
206 | |
207 | =head1 BUGS |
208 | |
209 | Probably plenty, test suite certainly isn't comprehensive.. Patches welcome. |
210 | |
211 | =head1 AUTHOR |
212 | |
213 | Tomas Doran (t0m) <bobtfish@bobtfish.net> |
214 | |
215 | =head1 LICENSE |
216 | |
217 | This code is copyright (c) 2009 Tomas Doran. This code is licensed on the same terms as perl |
218 | itself. |
219 | |
220 | =cut |
221 | |