We already need 0004, use the new shiny in test app, and turn off debug
[catagits/CatalystX-DynamicComponent.git] / lib / CatalystX / DynamicComponent.pm
CommitLineData
59fc9d16 1package CatalystX::DynamicComponent;
53a42ae0 2use MooseX::Role::Parameterized;
ac8aab7d 3use MooseX::Types::Moose qw/Str CodeRef HashRef ArrayRef/;
4use Catalyst::Utils;
5use Moose::Util::TypeConstraints;
6use List::MoreUtils qw/uniq/;
046d763d 7use namespace::autoclean;
59fc9d16 8
ac8aab7d 9enum __PACKAGE__ . '::ResolveStrategy' => qw/
10 merge
11 replace
12/;
13
104abdae 14our $VERSION = 0.000001;
15
53a42ae0 16parameter 'name' => (
0b07685c 17 isa => Str,
53a42ae0 18 required => 1,
19);
20
21parameter 'pre_immutable_hook' => (
0b07685c 22 isa => Str,
53a42ae0 23 predicate => 'has_pre_immutable_hook',
24);
25
ac8aab7d 26my %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.
45foreach 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
57my %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.
70my $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 78role {
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
1161;
117
dc7781e3 118__END__
119
120=head1 NAME
121
122CatalystX::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
147CatalystX::DynamicComponent aims to provide a flexible and reuseable method of building generic
148Catalyst components and registering them with your application.
149
150To give you this flexibility, it is implemented as a parametrised role which curries a
151component builder into your current package at application time.
152
153Authors of specific dynamic component builders are expected to be implemented as application class
154roles which compose this role, but provide their own advice around the C<< setup_compontens >>
155method, 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
161B<Required> - The name of the component generator method to curry.
162
163=head2 COMPONENT
164
165Optional, either a L<Class::MOP::Method>, or a plain code ref of a COMPONENT method to apply to
166the dynamically generated package before making it immutable.
167
168=head2 pre_immutable_hook
169
170Optional, method to call after a component has been generated, but before it is made immutable,
171constructed, and added to your component registry.
172
173=head1 CURRIED COMPONENT GENERATOR
174
175=head2 ARGUMENTS
176
177=over
178
6ba37fba 179=item *
180
181$component_name (E.g. C<< MyApp::Controller::Foo >>)
182
183=item *
184
185$config (E.g. C<< $c->config->{$component_name} >>)
dc7781e3 186
6ba37fba 187=back
dc7781e3 188
189=head2 OPERATION
190
191FIXME
192
193=head1 TODO
194
195=over
196
197=item *
198
199Better default handling of config - by default component should get config from where it normally
200does!
201
202=item *
203
204Abstract handling of role application / class name. This should not just be the component config
205by default.
206
207=item *
208
209Have some actual tests which test just this crap, and not all the other classes together.
210
211=back
212
213=head1 BUGS
214
215Probably plenty, test suite certainly isn't comprehensive.. Patches welcome.
216
217=head1 AUTHOR
218
219Tomas Doran (t0m) <bobtfish@bobtfish.net>
220
221=head1 LICENSE
222
223This code is copyright (c) 2009 Tomas Doran. This code is licensed on the same terms as perl
224itself.
225
226=cut
227