a few fixes in the test, and the actual method
[catagits/Catalyst-Runtime.git] / lib / Catalyst / IOC / Container.pm
CommitLineData
a6c13ff4 1package Catalyst::IOC::Container;
2ebff184 2use Bread::Board qw/depends_on/;
b4a6fa62 3use Moose;
4use Config::Any;
5use Data::Visitor::Callback;
6use Catalyst::Utils ();
ae0690a5 7use List::Util qw(first);
d3742403 8use Devel::InnerPackage ();
b4410fc3 9use Hash::Util qw/lock_hash/;
2bb0da6d 10use MooseX::Types::LoadableClass qw/ LoadableClass /;
0dff29e2 11use Moose::Util;
6a23ae28 12use Scalar::Util qw/refaddr/;
ff0e9735 13use Catalyst::IOC::BlockInjection;
b7da37bd 14use Catalyst::IOC::ConstructorInjection;
2f32de9a 15use Module::Pluggable::Object ();
8b749525 16use namespace::autoclean;
b4a6fa62 17
18extends 'Bread::Board::Container';
19
20has config_local_suffix => (
442ab13e 21 is => 'ro',
b4a6fa62 22 isa => 'Str',
23 default => 'local',
24);
25
26has driver => (
442ab13e 27 is => 'ro',
b4a6fa62 28 isa => 'HashRef',
29 default => sub { +{} },
30);
31
32has file => (
442ab13e 33 is => 'ro',
b4a6fa62 34 isa => 'Str',
35 default => '',
36);
37
38has substitutions => (
442ab13e 39 is => 'ro',
b4a6fa62 40 isa => 'HashRef',
41 default => sub { +{} },
42);
43
2bb0da6d 44has 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 54sub BUILD {
a2c0d071 55 my ( $self, $params ) = @_;
b4a6fa62 56
292277c1 57 $self->add_service(
58 $self->${\"build_${_}_service"}
59 ) for qw/
7451d1ea 60 substitutions
61 file
62 driver
96c9f5d4 63 catalyst_application
7451d1ea 64 prefix
65 extensions
66 path
67 config
68 raw_config
69 global_files
70 local_files
71 global_config
72 local_config
0fcf9a51 73 class_config
7451d1ea 74 config_local_suffix
75 config_path
3e4f5406 76 locate_components
1a5adaee 77 home
78 root_dir
7451d1ea 79 /;
f04816ce 80
0fcf9a51 81 my $config = $self->resolve( service => 'config' );
82
cd20de09 83 # don't force default_component to be undef if the config wasn't set
84 my @default_view = $config->{default_view}
85 ? ( default_component => $config->{default_view} )
86 : ( )
87 ;
88 my @default_model = $config->{default_model}
89 ? ( default_component => $config->{default_model} )
90 : ( )
91 ;
92
292277c1 93 $self->add_sub_container(
ff0e9735 94 $self->build_component_subcontainer
95 );
96
97 $self->add_sub_container(
a2c0d071 98 $self->build_controller_subcontainer
99 );
100
101 $self->add_sub_container(
cd20de09 102 $self->build_view_subcontainer( @default_view )
a2c0d071 103 );
104
105 $self->add_sub_container(
cd20de09 106 $self->build_model_subcontainer( @default_model )
a2c0d071 107 );
85ebb635 108
109 {
110 no strict 'refs';
6a23ae28 111 no warnings 'once';
85ebb635 112 my $class = ref $self;
13398eb0 113 ${ $class . '::customise_container' }->($self)
114 if ${ $class . '::customise_container' };
85ebb635 115 }
f04816ce 116}
117
118sub build_model_subcontainer {
119 my $self = shift;
120
a2c0d071 121 return $self->new_sub_container( @_,
5a53ef3d 122 name => 'model',
b06ded69 123 );
f04816ce 124}
125
126sub build_view_subcontainer {
127 my $self = shift;
128
a2c0d071 129 return $self->new_sub_container( @_,
5a53ef3d 130 name => 'view',
b06ded69 131 );
f04816ce 132}
133
134sub build_controller_subcontainer {
135 my $self = shift;
136
b06ded69 137 return $self->new_sub_container(
5a53ef3d 138 name => 'controller',
b06ded69 139 );
f04816ce 140}
141
ff0e9735 142sub build_component_subcontainer {
143 my $self = shift;
144
145 return Bread::Board::Container->new(
146 name => 'component',
147 );
148}
149
10a10c42 150sub build_home_service {
151 my $self = shift;
152
153 return Bread::Board::BlockInjection->new(
154 lifecycle => 'Singleton',
155 name => 'home',
156 block => sub {
1a5adaee 157 my $self = shift;
96c9f5d4 158 my $class = $self->param('catalyst_application');
10a10c42 159
160 if ( my $env = Catalyst::Utils::env_value( $class, 'HOME' ) ) {
1a5adaee 161 return $env;
162 }
163
164 if ( my $home = $self->param('home_flag') ) {
165 return $home;
10a10c42 166 }
167
1a5adaee 168 return Catalyst::Utils::home($class);
169 },
170 parameters => {
171 home_flag => { is => 'ro', isa => 'Str|Undef', required => 0 }
10a10c42 172 },
96c9f5d4 173 dependencies => [ depends_on('catalyst_application') ],
10a10c42 174 );
175}
176
344858a7 177sub build_root_dir_service {
10a10c42 178 my $self = shift;
179
180 return Bread::Board::BlockInjection->new(
181 lifecycle => 'Singleton',
344858a7 182 name => 'root_dir',
10a10c42 183 block => sub {
184 my $self = shift;
185
186 return Path::Class::Dir->new( $self->param('home') )->subdir('root');
187 },
188 dependencies => [ depends_on('home') ],
189 );
190}
191
96c9f5d4 192sub build_catalyst_application_service {
f04816ce 193 my $self = shift;
292277c1 194
96c9f5d4 195 return Bread::Board::Literal->new( name => 'catalyst_application', value => $self->name );
f04816ce 196}
197
198sub build_driver_service {
199 my $self = shift;
292277c1 200
201 return Bread::Board::Literal->new( name => 'driver', value => $self->driver );
f04816ce 202}
203
204sub build_file_service {
205 my $self = shift;
292277c1 206
207 return Bread::Board::Literal->new( name => 'file', value => $self->file );
f04816ce 208}
209
210sub build_substitutions_service {
211 my $self = shift;
292277c1 212
213 return Bread::Board::Literal->new( name => 'substitutions', value => $self->substitutions );
f04816ce 214}
215
216sub build_extensions_service {
217 my $self = shift;
292277c1 218
219 return Bread::Board::BlockInjection->new(
7a267bb5 220 lifecycle => 'Singleton',
292277c1 221 name => 'extensions',
222 block => sub {
223 return \@{Config::Any->extensions};
224 },
f04816ce 225 );
226}
b4a6fa62 227
f04816ce 228sub build_prefix_service {
229 my $self = shift;
292277c1 230
231 return Bread::Board::BlockInjection->new(
7a267bb5 232 lifecycle => 'Singleton',
292277c1 233 name => 'prefix',
234 block => sub {
96c9f5d4 235 return Catalyst::Utils::appprefix( shift->param('catalyst_application') );
292277c1 236 },
96c9f5d4 237 dependencies => [ depends_on('catalyst_application') ],
f04816ce 238 );
239}
b4a6fa62 240
f04816ce 241sub build_path_service {
242 my $self = shift;
292277c1 243
244 return Bread::Board::BlockInjection->new(
7a267bb5 245 lifecycle => 'Singleton',
292277c1 246 name => 'path',
247 block => sub {
248 my $s = shift;
249
96c9f5d4 250 return Catalyst::Utils::env_value( $s->param('catalyst_application'), 'CONFIG' )
292277c1 251 || $s->param('file')
96c9f5d4 252 || $s->param('catalyst_application')->path_to( $s->param('prefix') );
292277c1 253 },
96c9f5d4 254 dependencies => [ depends_on('file'), depends_on('catalyst_application'), depends_on('prefix') ],
f04816ce 255 );
256}
b4a6fa62 257
f04816ce 258sub build_config_service {
259 my $self = shift;
292277c1 260
261 return Bread::Board::BlockInjection->new(
7a267bb5 262 lifecycle => 'Singleton',
292277c1 263 name => 'config',
264 block => sub {
265 my $s = shift;
266
267 my $v = Data::Visitor::Callback->new(
268 plain_value => sub {
269 return unless defined $_;
96c9f5d4 270 return $self->_config_substitutions( $s->param('catalyst_application'), $s->param('substitutions'), $_ );
292277c1 271 }
272
273 );
274 $v->visit( $s->param('raw_config') );
275 },
96c9f5d4 276 dependencies => [ depends_on('catalyst_application'), depends_on('raw_config'), depends_on('substitutions') ],
f04816ce 277 );
278}
b4a6fa62 279
f04816ce 280sub build_raw_config_service {
281 my $self = shift;
292277c1 282
283 return Bread::Board::BlockInjection->new(
7a267bb5 284 lifecycle => 'Singleton',
292277c1 285 name => 'raw_config',
286 block => sub {
287 my $s = shift;
288
289 my @global = @{$s->param('global_config')};
290 my @locals = @{$s->param('local_config')};
291
0fcf9a51 292 my $config = $s->param('class_config');
293
292277c1 294 for my $cfg (@global, @locals) {
295 for (keys %$cfg) {
296 $config = Catalyst::Utils::merge_hashes( $config, $cfg->{$_} );
b4a6fa62 297 }
292277c1 298 }
0fcf9a51 299
292277c1 300 return $config;
301 },
0fcf9a51 302 dependencies => [ depends_on('global_config'), depends_on('local_config'), depends_on('class_config') ],
f04816ce 303 );
304}
b4a6fa62 305
f04816ce 306sub build_global_files_service {
307 my $self = shift;
b4a6fa62 308
292277c1 309 return Bread::Board::BlockInjection->new(
7a267bb5 310 lifecycle => 'Singleton',
292277c1 311 name => 'global_files',
312 block => sub {
313 my $s = shift;
b4a6fa62 314
292277c1 315 my ( $path, $extension ) = @{$s->param('config_path')};
b4a6fa62 316
292277c1 317 my @extensions = @{$s->param('extensions')};
318
319 my @files;
320 if ( $extension ) {
321 die "Unable to handle files with the extension '${extension}'" unless grep { $_ eq $extension } @extensions;
322 push @files, $path;
323 } else {
324 @files = map { "$path.$_" } @extensions;
325 }
326 return \@files;
327 },
328 dependencies => [ depends_on('extensions'), depends_on('config_path') ],
f04816ce 329 );
330}
b4a6fa62 331
f04816ce 332sub build_local_files_service {
333 my $self = shift;
292277c1 334
335 return Bread::Board::BlockInjection->new(
7a267bb5 336 lifecycle => 'Singleton',
292277c1 337 name => 'local_files',
338 block => sub {
339 my $s = shift;
340
341 my ( $path, $extension ) = @{$s->param('config_path')};
342 my $suffix = $s->param('config_local_suffix');
343
344 my @extensions = @{$s->param('extensions')};
345
346 my @files;
347 if ( $extension ) {
348 die "Unable to handle files with the extension '${extension}'" unless grep { $_ eq $extension } @extensions;
349 $path =~ s{\.$extension}{_$suffix.$extension};
350 push @files, $path;
351 } else {
352 @files = map { "${path}_${suffix}.$_" } @extensions;
353 }
354 return \@files;
355 },
356 dependencies => [ depends_on('extensions'), depends_on('config_path'), depends_on('config_local_suffix') ],
f04816ce 357 );
358}
b4a6fa62 359
0fcf9a51 360sub build_class_config_service {
361 my $self = shift;
362
363 return Bread::Board::BlockInjection->new(
364 lifecycle => 'Singleton',
365 name => 'class_config',
366 block => sub {
367 my $s = shift;
96c9f5d4 368 my $app = $s->param('catalyst_application');
0fcf9a51 369
370 # Container might be called outside Catalyst context
371 return {} unless Class::MOP::is_class_loaded($app);
372
373 # config might not have been defined
374 return $app->config || {};
375 },
96c9f5d4 376 dependencies => [ depends_on('catalyst_application') ],
0fcf9a51 377 );
378}
379
f04816ce 380sub build_global_config_service {
381 my $self = shift;
292277c1 382
383 return Bread::Board::BlockInjection->new(
7a267bb5 384 lifecycle => 'Singleton',
292277c1 385 name => 'global_config',
386 block => sub {
387 my $s = shift;
388
389 return Config::Any->load_files({
390 files => $s->param('global_files'),
391 filter => \&_fix_syntax,
392 use_ext => 1,
393 driver_args => $s->param('driver'),
394 });
395 },
396 dependencies => [ depends_on('global_files') ],
f04816ce 397 );
398}
b4a6fa62 399
f04816ce 400sub build_local_config_service {
401 my $self = shift;
292277c1 402
403 return Bread::Board::BlockInjection->new(
7a267bb5 404 lifecycle => 'Singleton',
292277c1 405 name => 'local_config',
406 block => sub {
407 my $s = shift;
408
409 return Config::Any->load_files({
410 files => $s->param('local_files'),
411 filter => \&_fix_syntax,
412 use_ext => 1,
413 driver_args => $s->param('driver'),
414 });
415 },
416 dependencies => [ depends_on('local_files') ],
f04816ce 417 );
418}
b4a6fa62 419
f04816ce 420sub build_config_path_service {
421 my $self = shift;
b4a6fa62 422
292277c1 423 return Bread::Board::BlockInjection->new(
7a267bb5 424 lifecycle => 'Singleton',
292277c1 425 name => 'config_path',
426 block => sub {
427 my $s = shift;
b4a6fa62 428
292277c1 429 my $path = $s->param('path');
430 my $prefix = $s->param('prefix');
b4a6fa62 431
292277c1 432 my ( $extension ) = ( $path =~ m{\.(.{1,4})$} );
433
434 if ( -d $path ) {
435 $path =~ s{[\/\\]$}{};
436 $path .= "/$prefix";
437 }
b4a6fa62 438
292277c1 439 return [ $path, $extension ];
440 },
441 dependencies => [ depends_on('prefix'), depends_on('path') ],
f04816ce 442 );
443}
b4a6fa62 444
f04816ce 445sub build_config_local_suffix_service {
446 my $self = shift;
292277c1 447
448 return Bread::Board::BlockInjection->new(
7a267bb5 449 lifecycle => 'Singleton',
292277c1 450 name => 'config_local_suffix',
451 block => sub {
452 my $s = shift;
96c9f5d4 453 my $suffix = Catalyst::Utils::env_value( $s->param('catalyst_application'), 'CONFIG_LOCAL_SUFFIX' ) || $self->config_local_suffix;
292277c1 454
455 return $suffix;
456 },
96c9f5d4 457 dependencies => [ depends_on('catalyst_application') ],
f04816ce 458 );
b4a6fa62 459}
460
3e4f5406 461sub build_locate_components_service {
462 my $self = shift;
463
464 return Bread::Board::BlockInjection->new(
465 lifecycle => 'Singleton',
466 name => 'locate_components',
467 block => sub {
468 my $s = shift;
96c9f5d4 469 my $class = $s->param('catalyst_application');
3e4f5406 470 my $config = $s->param('config')->{ setup_components };
471
472 Catalyst::Exception->throw(
473 qq{You are using search_extra config option. That option is\n} .
474 qq{deprecated, please refer to the documentation for\n} .
475 qq{other ways of achieving the same results.\n}
476 ) if delete $config->{ search_extra };
477
478 my @paths = qw( ::Controller ::C ::Model ::M ::View ::V );
479
480 my $locator = Module::Pluggable::Object->new(
481 search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
482 %$config
483 );
484
b47ed80b 485 return [ $locator->plugins ];
3e4f5406 486 },
96c9f5d4 487 dependencies => [ depends_on('catalyst_application'), depends_on('config') ],
3e4f5406 488 );
489}
490
88d81c1b 491sub setup_components {
fa6607ec 492 my $self = shift;
96c9f5d4 493 my $class = $self->resolve( service => 'catalyst_application' );
88d81c1b 494 my @comps = @{ $self->resolve( service => 'locate_components' ) };
495 my %comps = map { $_ => 1 } @comps;
496 my $deprecatedcatalyst_component_names = 0;
fa6607ec 497
6a23ae28 498 my $app_locate_components_addr = refaddr(
499 $class->can('locate_components')
500 );
501 my $cat_locate_components_addr = refaddr(
502 Catalyst->can('locate_components')
503 );
504
505 if ($app_locate_components_addr != $cat_locate_components_addr) {
61915b48 506 # FIXME - why not just say: @comps = $class->locate_components() ?
6a23ae28 507 $class->log->warn(qq{You have overridden locate_components. That } .
508 qq{no longer works. Please refer to the documentation to achieve } .
509 qq{similar results.\n}
510 );
511 }
512
88d81c1b 513 for my $component ( @comps ) {
fa6607ec 514
88d81c1b 515 # We pass ignore_loaded here so that overlay files for (e.g.)
516 # Model::DBI::Schema sub-classes are loaded - if it's in @comps
517 # we know M::P::O found a file on disk so this is safe
fa6607ec 518
88d81c1b 519 Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
520 }
fa6607ec 521
88d81c1b 522 for my $component (@comps) {
6e2a1222 523 $self->add_component( $component );
88d81c1b 524 # FIXME - $instance->expand_modules() is broken
525 my @expanded_components = $self->expand_component_module( $component );
526
527 if (
528 !$deprecatedcatalyst_component_names &&
529 ($deprecatedcatalyst_component_names = $component =~ m/::[CMV]::/) ||
530 ($deprecatedcatalyst_component_names = grep { /::[CMV]::/ } @expanded_components)
531 ) {
532 # FIXME - should I be calling warn here?
6e2a1222 533 # Maybe it's time to remove it, or become fatal
88d81c1b 534 $class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}.
535 qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n}
536 );
537 }
fa6607ec 538
88d81c1b 539 for my $component (@expanded_components) {
6e2a1222 540 $self->add_component( $component )
88d81c1b 541 unless $comps{$component};
542 }
543 }
fa6607ec 544}
545
b4a6fa62 546sub _fix_syntax {
547 my $config = shift;
548 my @components = (
549 map +{
550 prefix => $_ eq 'Component' ? '' : $_ . '::',
551 values => delete $config->{ lc $_ } || delete $config->{ $_ }
552 },
553 grep { ref $config->{ lc $_ } || ref $config->{ $_ } }
554 qw( Component Model M View V Controller C Plugin )
555 );
556
557 foreach my $comp ( @components ) {
558 my $prefix = $comp->{ prefix };
559 foreach my $element ( keys %{ $comp->{ values } } ) {
560 $config->{ "$prefix$element" } = $comp->{ values }->{ $element };
561 }
562 }
563}
564
565sub _config_substitutions {
6682389c 566 my ( $self, $name, $subs, $arg ) = @_;
b4a6fa62 567
568 $subs->{ HOME } ||= sub { shift->path_to( '' ); };
569 $subs->{ ENV } ||=
570 sub {
571 my ( $c, $v ) = @_;
572 if (! defined($ENV{$v})) {
573 Catalyst::Exception->throw( message =>
574 "Missing environment variable: $v" );
575 return "";
576 } else {
577 return $ENV{ $v };
578 }
579 };
580 $subs->{ path_to } ||= sub { shift->path_to( @_ ); };
581 $subs->{ literal } ||= sub { return $_[ 1 ]; };
582 my $subsre = join( '|', keys %$subs );
583
6682389c 584 $arg =~ s{__($subsre)(?:\((.+?)\))?__}{ $subs->{ $1 }->( $name, $2 ? split( /,/, $2 ) : () ) }eg;
585 return $arg;
b4a6fa62 586}
587
a17e0ff8 588sub get_component_from_sub_container {
589 my ( $self, $sub_container_name, $name, $c, @args ) = @_;
590
591 my $sub_container = $self->get_sub_container( $sub_container_name );
592
0e747f0c 593 if (!$name) {
a2c0d071 594 my $default = $sub_container->default_component;
0e747f0c 595
596 return $sub_container->get_component( $default, $c, @args )
597 if $default && $sub_container->has_service( $default );
598
a0146296 599 # FIXME - should I be calling $c->log->warn here?
0e747f0c 600 # this is never a controller, so this is safe
601 $c->log->warn( "Calling \$c->$sub_container_name() is not supported unless you specify one of:" );
602 $c->log->warn( "* \$c->config(default_$sub_container_name => 'the name of the default $sub_container_name to use')" );
603 $c->log->warn( "* \$c->stash->{current_$sub_container_name} # the name of the view to use for this request" );
604 $c->log->warn( "* \$c->stash->{current_${sub_container_name}_instance} # the instance of the $sub_container_name to use for this request" );
a2c0d071 605
606 return;
0e747f0c 607 }
608
a17e0ff8 609 return $sub_container->get_component_regexp( $name, $c, @args )
610 if ref $name;
611
612 return $sub_container->get_component( $name, $c, @args )
613 if $sub_container->has_service( $name );
614
615 $c->log->warn(
616 "Attempted to use $sub_container_name '$name', " .
617 "but it does not exist"
618 );
619
620 return;
621}
622
c4aedec7 623sub find_component {
ec17c391 624 my ( $self, $component, @args ) = @_;
f147e6c2 625 my ( $type, $name ) = _get_component_type_name($component);
c4aedec7 626 my @result;
627
d0f954b4 628 return $self->get_component_from_sub_container(
ec17c391 629 $type, $name, @args
d0f954b4 630 ) if $type;
631
c4aedec7 632 my $query = ref $component
633 ? $component
634 : qr{^$component$}
635 ;
636
637 for my $subcontainer_name (qw/model view controller/) {
a0146296 638 my $subcontainer = $self->get_sub_container( $subcontainer_name );
c4aedec7 639 my @components = $subcontainer->get_service_list;
640 @result = grep { m{$component} } @components;
641
ec17c391 642 return map { $subcontainer->get_component( $_, @args ) } @result
c4aedec7 643 if @result;
644 }
645
d0f954b4 646 # one last search for things like $c->comp(qr/::M::/)
ae9bf2af 647 @result = $self->_find_component_regexp(
ec17c391 648 $component, @args
d0f954b4 649 ) if !@result and ref $component;
650
c4aedec7 651 # it expects an empty list on failed searches
652 return @result;
653}
654
ae9bf2af 655sub _find_component_regexp {
9084f394 656 my ( $self, $component, $ctx, @args ) = @_;
4e2b302e 657 my @result;
658
9084f394 659 my @components = grep { m{$component} } keys %{ $self->get_all_components($ctx) };
4e2b302e 660
661 for (@components) {
f147e6c2 662 my ($type, $name) = _get_component_type_name($_);
4e2b302e 663
664 push @result, $self->get_component_from_sub_container(
9084f394 665 $type, $name, $ctx, @args
4e2b302e 666 ) if $type;
667 }
668
669 return @result;
670}
671
e75fd3e4 672# FIXME
673# what exactly should this method return?
674# By default, for back-compatibility, we have two services for each component:
675# - one in the model|view|controller sub-container
676# - and another in the component sub-container
677# the latter is a Singleton, it executes the COMPONENT method, and the first
678# is executed at every call, executing ACCEPT_CONTEXT. It's just a layer.
679#
680# So the one in $type sub-container is pretty useless by default. But when the
681# user overrides the container (which is what we want), the sub-container they
682# will use is precisely $type, not 'component'. So for now, I'm returning both
683# services, to decide later what to do.
684sub get_all_component_services {
685 my ($self, $class) = @_;
686 my %components;
687 my $components_container = $self->get_sub_container('component');
688
689 foreach my $type (qw/model view controller /) {
690 my $container = $self->get_sub_container($type);
691
692 for my $component ($container->get_service_list) {
693 my $comp_service = $container->get_service($component);
694
695 my $key = $comp_service->catalyst_component_name;
696 my %values = (
697 type => $type,
698 service => $comp_service,
699 );
700
701 my $comp_name = "${type}_${component}";
702 if ($components_container->has_service($comp_name)) {
703 $values{backcompat_service} = $components_container->get_service($comp_name);
704 }
705
706 $components{$key} = \%values;
707 }
708 }
709
710 return lock_hash %components;
711}
712
dcc2a475 713sub get_all_singleton_lifecycle_components {
714 my $self = shift;
715
716 my %components;
717 my $components_container = $self->get_sub_container('component');
718
719 foreach my $type (qw/model view controller /) {
720 my $container = $self->get_sub_container($type);
721
722 for my $component ($container->get_service_list) {
723 my $comp_service = $container->get_service($component);
724
725 my $key = $comp_service->catalyst_component_name;
726 my $lifecycle = $comp_service->lifecycle;
727 my $comp_name = "${type}_${component}";
728
729 if (defined $lifecycle && $lifecycle eq 'Singleton') {
730 $components{$key} = $comp_service->get;
731 }
732 elsif ($components_container->has_service($comp_name)) {
733 $components{$key} = $components_container->get_service($comp_name)->get;
734 }
735 }
736 }
737
738 return lock_hash %components;
739}
740
b4410fc3 741sub get_all_components {
9084f394 742 my ($self, $class) = @_;
b4410fc3 743 my %components;
744
abefa111 745 # FIXME - if we're getting from these containers, we need to either:
746 # - pass 'ctx' and 'accept_context_args' OR
747 # - make these params optional
287df7b2 748 # big problem when setting up the dispatcher - this method is called
749 # as $container->get_all_components('MyApp'). What to do with Request
750 # life cycles?
3552850b 751 foreach my $type (qw/model view controller /) {
b32d8169 752 my $container = $self->get_sub_container($type);
3552850b 753
754 for my $component ($container->get_service_list) {
9084f394 755 my $comp_service = $container->get_service($component);
c887dd0d 756
9084f394 757 $components{$comp_service->catalyst_component_name} = $comp_service->get(ctx => $class);
3552850b 758 }
b4410fc3 759 }
760
761 return lock_hash %components;
762}
763
f147e6c2 764sub add_component {
6e2a1222 765 my ( $self, $component ) = @_;
f147e6c2 766 my ( $type, $name ) = _get_component_type_name($component);
767
768 return unless $type;
769
b844dcad 770 # The 'component' sub-container will create the object, and store it's
771 # instance, which, by default, will live throughout the application.
772 # The model/view/controller sub-containers only reference the instance
773 # held in the aforementioned sub-container, and execute the ACCEPT_CONTEXT
774 # sub every time they are called, when it exists.
775 my $instance_container = $self->get_sub_container('component');
776 my $accept_context_container = $self->get_sub_container($type);
777
25af999b 778 # Custom containers might have added the service already
779 # We don't want to override that
780 return if $accept_context_container->has_service( $name );
781
782 my $component_service_name = "${type}_${name}";
783
b844dcad 784 $instance_container->add_service(
b7da37bd 785 Catalyst::IOC::ConstructorInjection->new(
ff0e9735 786 name => $component_service_name,
28ec44a3 787 catalyst_component_name => $component,
b7da37bd 788 class => $component,
ff0e9735 789 lifecycle => 'Singleton',
bf142143 790 dependencies => [
96c9f5d4 791 depends_on( '/catalyst_application' ),
bf142143 792 ],
a987f40a 793 ),
25af999b 794 );
a987f40a 795 # XXX - FIXME - We have to explicitly build the service here,
796 # causing the COMPONENT method to be called early here, as otherwise
797 # if the component method defines other classes (e.g. the
798 # ACCEPT_CONTEXT injection Model::DBIC::Schema does)
799 # then they won't be found by Devel::InnerPackage
800 # see also t/aggregate/unit_core_component_loading.t
801 $instance_container->get_service($component_service_name)->get;
ff0e9735 802
b844dcad 803 $accept_context_container->add_service(
ff0e9735 804 Catalyst::IOC::BlockInjection->new(
805 name => $name,
9084f394 806 catalyst_component_name => $component,
ff0e9735 807 dependencies => [
808 depends_on( "/component/$component_service_name" ),
809 ],
b844dcad 810 block => sub { shift->param($component_service_name) },
f147e6c2 811 )
25af999b 812 );
f147e6c2 813}
814
815# FIXME: should this sub exist?
816# should it be moved to Catalyst::Utils,
817# or replaced by something already existing there?
818sub _get_component_type_name {
819 my ( $component ) = @_;
ae0690a5 820 my $result;
f147e6c2 821
ae0690a5 822 while ( !$result and (my $index = index $component, '::') > 0 ) {
823 my $type = lc substr $component, 0, $index;
824 $component = substr $component, $index + 2;
825 $result = first { $type eq $_ or $type eq substr($_, 0, 1) }
826 qw{ model view controller };
f147e6c2 827 }
828
ae0690a5 829 return ($result, $component);
f147e6c2 830}
831
d3742403 832sub expand_component_module {
833 my ( $class, $module ) = @_;
834 return Devel::InnerPackage::list_packages( $module );
835}
0dff29e2 836
b4e19c62 837__PACKAGE__->meta->make_immutable;
838
d057ddb9 8391;
840
841__END__
842
843=pod
844
845=head1 NAME
846
847Catalyst::Container - IOC for Catalyst components
848
2c2ed473 849=head1 SYNOPSIS
850
851=head1 DESCRIPTION
852
d057ddb9 853=head1 METHODS
854
61915b48 855=head1 Methods for Building Containers
a0146296 856
309caf39 857=head2 build_component_subcontainer
858
859Container that stores all components, i.e. all models, views and controllers
860together. Each service is an instance of the actual component, and by default
861it lives while the application is running. Retrieving components from this
202784d3 862sub-container will instantiate the component, if it hasn't been instantiated
309caf39 863already, but will not execute ACCEPT_CONTEXT.
864
d057ddb9 865=head2 build_model_subcontainer
866
309caf39 867Container that stores references for all models that are inside the components
202784d3 868sub-container. Retrieving a model triggers ACCEPT_CONTEXT, if it exists.
a0146296 869
d057ddb9 870=head2 build_view_subcontainer
871
309caf39 872Same as L<build_model_subcontainer>, but for views.
a0146296 873
d057ddb9 874=head2 build_controller_subcontainer
875
59221ae6 876Same as L<build_model_subcontainer>, but for controllers.
a0146296 877
61915b48 878=head1 Methods for Building Services
a0146296 879
96c9f5d4 880=head2 build_catalyst_application_service
d057ddb9 881
a4541222 882Name of the application (such as MyApp).
a0146296 883
6c6ada81 884=head2 build_home_service
885
886The application home directory. All the files (including classes, scripts, etc)
887created for this application are in this directory, or in a sub-directory below
888this one.
889
890=head2 build_root_dir_service
891
892Inside the application home (as explained in L</build_home_service>), there is
893a root directory. This is where all templates and static files are.
894
d057ddb9 895=head2 build_driver_service
896
a0146296 897Config options passed directly to the driver being used.
898
d057ddb9 899=head2 build_file_service
900
a0146296 901?
902
d057ddb9 903=head2 build_substitutions_service
904
bbb306a9 905This method substitutes macros found with calls to a function. There are a
906number of default macros:
907
908=over
909
910=item * C<__HOME__> - replaced with C<$c-E<gt>path_to('')>
911
912=item * C<__ENV(foo)__> - replaced with the value of C<$ENV{foo}>
913
914=item * C<__path_to(foo/bar)__> - replaced with C<$c-E<gt>path_to('foo/bar')>
915
916=item * C<__literal(__FOO__)__> - leaves __FOO__ alone (allows you to use
917C<__DATA__> as a config value, for example)
918
919=back
920
921The parameter list is split on comma (C<,>). You can override this method to
922do your own string munging, or you can define your own macros in
5faa454d 923C<< <MyApp->config( 'Plugin::ConfigLoader' => { substitutions => { ... } } ) >>.
bbb306a9 924Example:
925
5faa454d 926 MyApp->config( 'Plugin::ConfigLoader' => {
927 substitutions => {
928 baz => sub { my $c = shift; qux( @_ ); },
929 },
930 });
bbb306a9 931
932The above will respond to C<__baz(x,y)__> in config strings.
a0146296 933
d057ddb9 934=head2 build_extensions_service
935
bbb306a9 936Config::Any's available config file extensions (e.g. xml, json, pl, etc).
937
d057ddb9 938=head2 build_prefix_service
939
202784d3 940The prefix, based on the application name, that will be used to look-up the
bbb306a9 941config files (which will be in the format $prefix.$extension). If the app is
942MyApp::Foo, the prefix will be myapp_foo.
943
d057ddb9 944=head2 build_path_service
945
bbb306a9 946The path to the config file (or environment variable, if defined).
947
d057ddb9 948=head2 build_config_service
949
bbb306a9 950The resulting configuration for the application, after it has successfully
951been loaded, and all substitutions have been made.
952
d057ddb9 953=head2 build_raw_config_service
954
bbb306a9 955The merge of local_config and global_config hashes, before substitutions.
956
d057ddb9 957=head2 build_global_files_service
958
bbb306a9 959Gets all files for config that don't have the local_suffix, such as myapp.conf.
960
d057ddb9 961=head2 build_local_files_service
962
bbb306a9 963Gets all files for config that have the local_suffix, such as myapp_local.conf.
964
d057ddb9 965=head2 build_global_config_service
966
bbb306a9 967Reads config from global_files.
968
d057ddb9 969=head2 build_local_config_service
970
bbb306a9 971Reads config from local_files.
972
800a31b0 973=head2 build_class_config_service
974
975Reads config set from the application's class attribute config,
976i.e. MyApp->config( name => 'MyApp', ... )
977
d057ddb9 978=head2 build_config_path_service
979
bbb306a9 980Splits the path to the config file, and returns on array ref containing
981the path to the config file minus the extension in the first position,
982and the extension in the second.
983
d057ddb9 984=head2 build_config_local_suffix_service
985
a0146296 986Determines the suffix of files used to override the main config. By default
987this value is C<local>, which will load C<myapp_local.conf>. The suffix can
988be specified in the following order of preference:
989
990=over
991
992=item * C<$ENV{ MYAPP_CONFIG_LOCAL_SUFFIX }>
993
994=item * C<$ENV{ CATALYST_CONFIG_LOCAL_SUFFIX }>
995
996=back
997
998The first one of these values found replaces the default of C<local> in the
999name of the local config file to be loaded.
1000
1001For example, if C< $ENV{ MYAPP_CONFIG_LOCAL_SUFFIX }> is set to C<testing>,
1002ConfigLoader will try and load C<myapp_testing.conf> instead of
1003C<myapp_local.conf>.
1004
bbb306a9 1005=head2 build_locate_components_service
1006
1007This method is meant to provide a list of component modules that should be
1008setup for the application. By default, it will use L<Module::Pluggable>.
1009
1010Specify a C<setup_components> config option to pass additional options directly
1011to L<Module::Pluggable>.
1012
1013=head1 Other methods
1014
a0146296 1015=head2 get_component_from_sub_container($sub_container, $name, $c, @args)
1016
202784d3 1017Looks for components in a given sub-container (such as controller, model or
164a0b2b 1018view), and returns the searched component. If $name is undef, it returns the
1019default component (such as default_view, if $sub_container is 'view'). If
1020$name is a regexp, it returns an array of matching components. Otherwise, it
1021looks for the component with name $name.
8dc2fca3 1022
b4410fc3 1023=head2 get_all_components
1024
164a0b2b 1025Fetches all the components, in each of the sub_containers model, view and
202784d3 1026controller, and returns a read-only hash. The keys are the class names, and
164a0b2b 1027the values are the blessed objects. This is what is returned by $c->components.
a0146296 1028
f147e6c2 1029=head2 add_component
1030
202784d3 1031Adds a component to the appropriate sub-container. The sub-container is guessed
164a0b2b 1032by the component name given.
a0146296 1033
c4aedec7 1034=head2 find_component
1035
164a0b2b 1036Searches for components in all containers. If $component is the full class
202784d3 1037name, the sub-container is guessed, and it gets the searched component in there.
1038Otherwise, it looks for a component with that name in all sub-containers. If
ae9bf2af 1039$component is a regexp it calls _find_component_regexp and matches all
1040components against that regexp.
a0146296 1041
6e2a1222 1042=head2 expand_component_module
d3742403 1043
1044Components found by C<locate_components> will be passed to this method, which
1045is expected to return a list of component (package) names to be set up.
1046
ebf7f0a5 1047=head2 setup_components
fa6607ec 1048
61915b48 1049Uses locate_components service to list the components, and adds them to the
202784d3 1050appropriate sub-containers, using add_component().
61915b48 1051
bf3c8088 1052=head1 AUTHORS
1053
e8ed391e 1054Catalyst Contributors, see Catalyst.pm
bf3c8088 1055
e8ed391e 1056=head1 COPYRIGHT
bf3c8088 1057
1058This library is free software. You can redistribute it and/or modify it under
1059the same terms as Perl itself.
1060
1061=cut