Commit | Line | Data |
a6c13ff4 |
1 | package Catalyst::IOC::Container; |
b4a6fa62 |
2 | use Bread::Board; |
3 | use Moose; |
4 | use Config::Any; |
5 | use Data::Visitor::Callback; |
6 | use Catalyst::Utils (); |
2bb0da6d |
7 | use MooseX::Types::LoadableClass qw/ LoadableClass /; |
a6c13ff4 |
8 | use Catalyst::IOC::BlockInjection; |
8b749525 |
9 | use namespace::autoclean; |
b4a6fa62 |
10 | |
11 | extends 'Bread::Board::Container'; |
12 | |
8b749525 |
13 | # FIXME - Why do any of these attributes need to be rw? |
b4a6fa62 |
14 | has config_local_suffix => ( |
15 | is => 'rw', |
16 | isa => 'Str', |
17 | default => 'local', |
18 | ); |
19 | |
20 | has driver => ( |
21 | is => 'rw', |
22 | isa => 'HashRef', |
23 | default => sub { +{} }, |
24 | ); |
25 | |
26 | has file => ( |
27 | is => 'rw', |
28 | isa => 'Str', |
29 | default => '', |
30 | ); |
31 | |
32 | has substitutions => ( |
33 | is => 'rw', |
34 | isa => 'HashRef', |
35 | default => sub { +{} }, |
36 | ); |
37 | |
38 | has name => ( |
39 | is => 'rw', |
40 | isa => 'Str', |
41 | default => 'TestApp', |
42 | ); |
43 | |
2bb0da6d |
44 | has sub_container_class => ( |
45 | isa => LoadableClass, |
46 | is => 'ro', |
47 | coerce => 1, |
a6c13ff4 |
48 | default => 'Catalyst::IOC::SubContainer', |
8b749525 |
49 | handles => { |
50 | new_sub_container => 'new', |
51 | } |
2bb0da6d |
52 | ); |
53 | |
b4a6fa62 |
54 | sub BUILD { |
55 | my $self = shift; |
56 | |
292277c1 |
57 | $self->add_service( |
58 | $self->${\"build_${_}_service"} |
59 | ) for qw/ |
7451d1ea |
60 | substitutions |
61 | file |
62 | driver |
63 | name |
64 | prefix |
65 | extensions |
66 | path |
67 | config |
68 | raw_config |
69 | global_files |
70 | local_files |
71 | global_config |
72 | local_config |
73 | config_local_suffix |
74 | config_path |
75 | /; |
f04816ce |
76 | |
292277c1 |
77 | $self->add_sub_container( |
78 | $self->${ \"build_${_}_subcontainer" } |
79 | ) for qw/ model view controller /; |
f04816ce |
80 | } |
81 | |
82 | sub build_model_subcontainer { |
83 | my $self = shift; |
84 | |
8b749525 |
85 | return $self->new_sub_container( name => 'model' ); |
f04816ce |
86 | } |
87 | |
88 | sub build_view_subcontainer { |
89 | my $self = shift; |
90 | |
8b749525 |
91 | return $self->new_sub_container( name => 'view' ); |
f04816ce |
92 | } |
93 | |
94 | sub build_controller_subcontainer { |
95 | my $self = shift; |
96 | |
8b749525 |
97 | return $self->new_sub_container( name => 'controller' ); |
f04816ce |
98 | } |
99 | |
f04816ce |
100 | sub build_name_service { |
101 | my $self = shift; |
292277c1 |
102 | |
103 | return Bread::Board::Literal->new( name => 'name', value => $self->name ); |
f04816ce |
104 | } |
105 | |
106 | sub build_driver_service { |
107 | my $self = shift; |
292277c1 |
108 | |
109 | return Bread::Board::Literal->new( name => 'driver', value => $self->driver ); |
f04816ce |
110 | } |
111 | |
112 | sub build_file_service { |
113 | my $self = shift; |
292277c1 |
114 | |
115 | return Bread::Board::Literal->new( name => 'file', value => $self->file ); |
f04816ce |
116 | } |
117 | |
118 | sub build_substitutions_service { |
119 | my $self = shift; |
292277c1 |
120 | |
121 | return Bread::Board::Literal->new( name => 'substitutions', value => $self->substitutions ); |
f04816ce |
122 | } |
123 | |
124 | sub build_extensions_service { |
125 | my $self = shift; |
292277c1 |
126 | |
127 | return Bread::Board::BlockInjection->new( |
128 | name => 'extensions', |
129 | block => sub { |
130 | return \@{Config::Any->extensions}; |
131 | }, |
f04816ce |
132 | ); |
133 | } |
b4a6fa62 |
134 | |
f04816ce |
135 | sub build_prefix_service { |
136 | my $self = shift; |
292277c1 |
137 | |
138 | return Bread::Board::BlockInjection->new( |
139 | name => 'prefix', |
140 | block => sub { |
141 | return Catalyst::Utils::appprefix( shift->param('name') ); |
142 | }, |
143 | dependencies => [ depends_on('name') ], |
f04816ce |
144 | ); |
145 | } |
b4a6fa62 |
146 | |
f04816ce |
147 | sub build_path_service { |
148 | my $self = shift; |
292277c1 |
149 | |
150 | return Bread::Board::BlockInjection->new( |
151 | name => 'path', |
152 | block => sub { |
153 | my $s = shift; |
154 | |
155 | return Catalyst::Utils::env_value( $s->param('name'), 'CONFIG' ) |
156 | || $s->param('file') |
157 | || $s->param('name')->path_to( $s->param('prefix') ); |
158 | }, |
159 | dependencies => [ depends_on('file'), depends_on('name'), depends_on('prefix') ], |
f04816ce |
160 | ); |
161 | } |
b4a6fa62 |
162 | |
f04816ce |
163 | sub build_config_service { |
164 | my $self = shift; |
292277c1 |
165 | |
166 | return Bread::Board::BlockInjection->new( |
167 | name => 'config', |
168 | block => sub { |
169 | my $s = shift; |
170 | |
171 | my $v = Data::Visitor::Callback->new( |
172 | plain_value => sub { |
173 | return unless defined $_; |
174 | return $self->_config_substitutions( $s->param('name'), $s->param('substitutions'), $_ ); |
175 | } |
176 | |
177 | ); |
178 | $v->visit( $s->param('raw_config') ); |
179 | }, |
180 | dependencies => [ depends_on('name'), depends_on('raw_config'), depends_on('substitutions') ], |
f04816ce |
181 | ); |
182 | } |
b4a6fa62 |
183 | |
f04816ce |
184 | sub build_raw_config_service { |
185 | my $self = shift; |
292277c1 |
186 | |
187 | return Bread::Board::BlockInjection->new( |
188 | name => 'raw_config', |
189 | block => sub { |
190 | my $s = shift; |
191 | |
192 | my @global = @{$s->param('global_config')}; |
193 | my @locals = @{$s->param('local_config')}; |
194 | |
195 | my $config = {}; |
196 | for my $cfg (@global, @locals) { |
197 | for (keys %$cfg) { |
198 | $config = Catalyst::Utils::merge_hashes( $config, $cfg->{$_} ); |
b4a6fa62 |
199 | } |
292277c1 |
200 | } |
201 | return $config; |
202 | }, |
203 | dependencies => [ depends_on('global_config'), depends_on('local_config') ], |
f04816ce |
204 | ); |
205 | } |
b4a6fa62 |
206 | |
f04816ce |
207 | sub build_global_files_service { |
208 | my $self = shift; |
b4a6fa62 |
209 | |
292277c1 |
210 | return Bread::Board::BlockInjection->new( |
211 | name => 'global_files', |
212 | block => sub { |
213 | my $s = shift; |
b4a6fa62 |
214 | |
292277c1 |
215 | my ( $path, $extension ) = @{$s->param('config_path')}; |
b4a6fa62 |
216 | |
292277c1 |
217 | my @extensions = @{$s->param('extensions')}; |
218 | |
219 | my @files; |
220 | if ( $extension ) { |
221 | die "Unable to handle files with the extension '${extension}'" unless grep { $_ eq $extension } @extensions; |
222 | push @files, $path; |
223 | } else { |
224 | @files = map { "$path.$_" } @extensions; |
225 | } |
226 | return \@files; |
227 | }, |
228 | dependencies => [ depends_on('extensions'), depends_on('config_path') ], |
f04816ce |
229 | ); |
230 | } |
b4a6fa62 |
231 | |
f04816ce |
232 | sub build_local_files_service { |
233 | my $self = shift; |
292277c1 |
234 | |
235 | return Bread::Board::BlockInjection->new( |
236 | name => 'local_files', |
237 | block => sub { |
238 | my $s = shift; |
239 | |
240 | my ( $path, $extension ) = @{$s->param('config_path')}; |
241 | my $suffix = $s->param('config_local_suffix'); |
242 | |
243 | my @extensions = @{$s->param('extensions')}; |
244 | |
245 | my @files; |
246 | if ( $extension ) { |
247 | die "Unable to handle files with the extension '${extension}'" unless grep { $_ eq $extension } @extensions; |
248 | $path =~ s{\.$extension}{_$suffix.$extension}; |
249 | push @files, $path; |
250 | } else { |
251 | @files = map { "${path}_${suffix}.$_" } @extensions; |
252 | } |
253 | return \@files; |
254 | }, |
255 | dependencies => [ depends_on('extensions'), depends_on('config_path'), depends_on('config_local_suffix') ], |
f04816ce |
256 | ); |
257 | } |
b4a6fa62 |
258 | |
f04816ce |
259 | sub build_global_config_service { |
260 | my $self = shift; |
292277c1 |
261 | |
262 | return Bread::Board::BlockInjection->new( |
263 | name => 'global_config', |
264 | block => sub { |
265 | my $s = shift; |
266 | |
267 | return Config::Any->load_files({ |
268 | files => $s->param('global_files'), |
269 | filter => \&_fix_syntax, |
270 | use_ext => 1, |
271 | driver_args => $s->param('driver'), |
272 | }); |
273 | }, |
274 | dependencies => [ depends_on('global_files') ], |
f04816ce |
275 | ); |
276 | } |
b4a6fa62 |
277 | |
f04816ce |
278 | sub build_local_config_service { |
279 | my $self = shift; |
292277c1 |
280 | |
281 | return Bread::Board::BlockInjection->new( |
282 | name => 'local_config', |
283 | block => sub { |
284 | my $s = shift; |
285 | |
286 | return Config::Any->load_files({ |
287 | files => $s->param('local_files'), |
288 | filter => \&_fix_syntax, |
289 | use_ext => 1, |
290 | driver_args => $s->param('driver'), |
291 | }); |
292 | }, |
293 | dependencies => [ depends_on('local_files') ], |
f04816ce |
294 | ); |
295 | } |
b4a6fa62 |
296 | |
f04816ce |
297 | sub build_config_path_service { |
298 | my $self = shift; |
b4a6fa62 |
299 | |
292277c1 |
300 | return Bread::Board::BlockInjection->new( |
301 | name => 'config_path', |
302 | block => sub { |
303 | my $s = shift; |
b4a6fa62 |
304 | |
292277c1 |
305 | my $path = $s->param('path'); |
306 | my $prefix = $s->param('prefix'); |
b4a6fa62 |
307 | |
292277c1 |
308 | my ( $extension ) = ( $path =~ m{\.(.{1,4})$} ); |
309 | |
310 | if ( -d $path ) { |
311 | $path =~ s{[\/\\]$}{}; |
312 | $path .= "/$prefix"; |
313 | } |
b4a6fa62 |
314 | |
292277c1 |
315 | return [ $path, $extension ]; |
316 | }, |
317 | dependencies => [ depends_on('prefix'), depends_on('path') ], |
f04816ce |
318 | ); |
319 | } |
b4a6fa62 |
320 | |
f04816ce |
321 | sub build_config_local_suffix_service { |
322 | my $self = shift; |
292277c1 |
323 | |
324 | return Bread::Board::BlockInjection->new( |
325 | name => 'config_local_suffix', |
326 | block => sub { |
327 | my $s = shift; |
328 | my $suffix = Catalyst::Utils::env_value( $s->param('name'), 'CONFIG_LOCAL_SUFFIX' ) || $self->config_local_suffix; |
329 | |
330 | return $suffix; |
331 | }, |
332 | dependencies => [ depends_on('name') ], |
f04816ce |
333 | ); |
b4a6fa62 |
334 | } |
335 | |
336 | sub _fix_syntax { |
337 | my $config = shift; |
338 | my @components = ( |
339 | map +{ |
340 | prefix => $_ eq 'Component' ? '' : $_ . '::', |
341 | values => delete $config->{ lc $_ } || delete $config->{ $_ } |
342 | }, |
343 | grep { ref $config->{ lc $_ } || ref $config->{ $_ } } |
344 | qw( Component Model M View V Controller C Plugin ) |
345 | ); |
346 | |
347 | foreach my $comp ( @components ) { |
348 | my $prefix = $comp->{ prefix }; |
349 | foreach my $element ( keys %{ $comp->{ values } } ) { |
350 | $config->{ "$prefix$element" } = $comp->{ values }->{ $element }; |
351 | } |
352 | } |
353 | } |
354 | |
355 | sub _config_substitutions { |
6682389c |
356 | my ( $self, $name, $subs, $arg ) = @_; |
b4a6fa62 |
357 | |
358 | $subs->{ HOME } ||= sub { shift->path_to( '' ); }; |
359 | $subs->{ ENV } ||= |
360 | sub { |
361 | my ( $c, $v ) = @_; |
362 | if (! defined($ENV{$v})) { |
363 | Catalyst::Exception->throw( message => |
364 | "Missing environment variable: $v" ); |
365 | return ""; |
366 | } else { |
367 | return $ENV{ $v }; |
368 | } |
369 | }; |
370 | $subs->{ path_to } ||= sub { shift->path_to( @_ ); }; |
371 | $subs->{ literal } ||= sub { return $_[ 1 ]; }; |
372 | my $subsre = join( '|', keys %$subs ); |
373 | |
6682389c |
374 | $arg =~ s{__($subsre)(?:\((.+?)\))?__}{ $subs->{ $1 }->( $name, $2 ? split( /,/, $2 ) : () ) }eg; |
375 | return $arg; |
b4a6fa62 |
376 | } |
377 | |
d057ddb9 |
378 | 1; |
379 | |
380 | __END__ |
381 | |
382 | =pod |
383 | |
384 | =head1 NAME |
385 | |
386 | Catalyst::Container - IOC for Catalyst components |
387 | |
388 | =head1 METHODS |
389 | |
390 | =head2 build_model_subcontainer |
391 | |
392 | =head2 build_view_subcontainer |
393 | |
394 | =head2 build_controller_subcontainer |
395 | |
396 | =head2 build_name_service |
397 | |
398 | =head2 build_driver_service |
399 | |
400 | =head2 build_file_service |
401 | |
402 | =head2 build_substitutions_service |
403 | |
404 | =head2 build_extensions_service |
405 | |
406 | =head2 build_prefix_service |
407 | |
408 | =head2 build_path_service |
409 | |
410 | =head2 build_config_service |
411 | |
412 | =head2 build_raw_config_service |
413 | |
414 | =head2 build_global_files_service |
415 | |
416 | =head2 build_local_files_service |
417 | |
418 | =head2 build_global_config_service |
419 | |
420 | =head2 build_local_config_service |
421 | |
422 | =head2 build_config_path_service |
423 | |
424 | =head2 build_config_local_suffix_service |
425 | |
426 | =head2 _fix_syntax |
427 | |
428 | =head2 _config_substitutions |
429 | |
bf3c8088 |
430 | =head1 AUTHORS |
431 | |
e8ed391e |
432 | Catalyst Contributors, see Catalyst.pm |
bf3c8088 |
433 | |
e8ed391e |
434 | =head1 COPYRIGHT |
bf3c8088 |
435 | |
436 | This library is free software. You can redistribute it and/or modify it under |
437 | the same terms as Perl itself. |
438 | |
439 | =cut |