1 package Catalyst::IOC::Container;
5 use Data::Visitor::Callback;
6 use Catalyst::Utils ();
7 use Devel::InnerPackage ();
8 use Hash::Util qw/lock_hash/;
9 use MooseX::Types::LoadableClass qw/ LoadableClass /;
11 use Catalyst::IOC::BlockInjection;
12 use Module::Pluggable::Object ();
13 use namespace::autoclean;
15 extends 'Bread::Board::Container';
17 has config_local_suffix => (
26 default => sub { +{} },
35 has substitutions => (
38 default => sub { +{} },
41 has application_name => (
47 has sub_container_class => (
51 default => 'Catalyst::IOC::SubContainer',
53 new_sub_container => 'new',
58 my ( $self, $params ) = @_;
61 $self->${\"build_${_}_service"}
80 $self->add_sub_container(
81 $self->build_controller_subcontainer
84 # FIXME - the config should be merged at this point
85 my $config = $self->resolve( service => 'config' );
86 my $default_view = $params->{default_view} || $config->{default_view};
87 my $default_model = $params->{default_model} || $config->{default_model};
89 $self->add_sub_container(
90 $self->build_view_subcontainer(
91 default_component => $default_view,
95 $self->add_sub_container(
96 $self->build_model_subcontainer(
97 default_component => $default_model,
102 sub build_model_subcontainer {
105 return $self->new_sub_container( @_,
110 sub build_view_subcontainer {
113 return $self->new_sub_container( @_,
118 sub build_controller_subcontainer {
121 return $self->new_sub_container(
122 name => 'controller',
126 sub build_name_service {
129 return Bread::Board::Literal->new( name => 'application_name', value => $self->application_name );
132 sub build_driver_service {
135 return Bread::Board::Literal->new( name => 'driver', value => $self->driver );
138 sub build_file_service {
141 return Bread::Board::Literal->new( name => 'file', value => $self->file );
144 sub build_substitutions_service {
147 return Bread::Board::Literal->new( name => 'substitutions', value => $self->substitutions );
150 sub build_extensions_service {
153 return Bread::Board::BlockInjection->new(
154 lifecycle => 'Singleton',
155 name => 'extensions',
157 return \@{Config::Any->extensions};
162 sub build_prefix_service {
165 return Bread::Board::BlockInjection->new(
166 lifecycle => 'Singleton',
169 return Catalyst::Utils::appprefix( shift->param('name') );
171 dependencies => [ depends_on('name') ],
175 sub build_path_service {
178 return Bread::Board::BlockInjection->new(
179 lifecycle => 'Singleton',
184 return Catalyst::Utils::env_value( $s->param('name'), 'CONFIG' )
186 || $s->param('application_name')->path_to( $s->param('prefix') );
188 dependencies => [ depends_on('file'), depends_on('application_name'), depends_on('prefix') ],
192 sub build_config_service {
195 return Bread::Board::BlockInjection->new(
196 lifecycle => 'Singleton',
201 my $v = Data::Visitor::Callback->new(
203 return unless defined $_;
204 return $self->_config_substitutions( $s->param('application_name'), $s->param('substitutions'), $_ );
208 $v->visit( $s->param('raw_config') );
210 dependencies => [ depends_on('application_name'), depends_on('raw_config'), depends_on('substitutions') ],
214 sub build_raw_config_service {
217 return Bread::Board::BlockInjection->new(
218 lifecycle => 'Singleton',
219 name => 'raw_config',
223 my @global = @{$s->param('global_config')};
224 my @locals = @{$s->param('local_config')};
227 for my $cfg (@global, @locals) {
229 $config = Catalyst::Utils::merge_hashes( $config, $cfg->{$_} );
234 dependencies => [ depends_on('global_config'), depends_on('local_config') ],
238 sub build_global_files_service {
241 return Bread::Board::BlockInjection->new(
242 lifecycle => 'Singleton',
243 name => 'global_files',
247 my ( $path, $extension ) = @{$s->param('config_path')};
249 my @extensions = @{$s->param('extensions')};
253 die "Unable to handle files with the extension '${extension}'" unless grep { $_ eq $extension } @extensions;
256 @files = map { "$path.$_" } @extensions;
260 dependencies => [ depends_on('extensions'), depends_on('config_path') ],
264 sub build_local_files_service {
267 return Bread::Board::BlockInjection->new(
268 lifecycle => 'Singleton',
269 name => 'local_files',
273 my ( $path, $extension ) = @{$s->param('config_path')};
274 my $suffix = $s->param('config_local_suffix');
276 my @extensions = @{$s->param('extensions')};
280 die "Unable to handle files with the extension '${extension}'" unless grep { $_ eq $extension } @extensions;
281 $path =~ s{\.$extension}{_$suffix.$extension};
284 @files = map { "${path}_${suffix}.$_" } @extensions;
288 dependencies => [ depends_on('extensions'), depends_on('config_path'), depends_on('config_local_suffix') ],
292 sub build_global_config_service {
295 return Bread::Board::BlockInjection->new(
296 lifecycle => 'Singleton',
297 name => 'global_config',
301 return Config::Any->load_files({
302 files => $s->param('global_files'),
303 filter => \&_fix_syntax,
305 driver_args => $s->param('driver'),
308 dependencies => [ depends_on('global_files') ],
312 sub build_local_config_service {
315 return Bread::Board::BlockInjection->new(
316 lifecycle => 'Singleton',
317 name => 'local_config',
321 return Config::Any->load_files({
322 files => $s->param('local_files'),
323 filter => \&_fix_syntax,
325 driver_args => $s->param('driver'),
328 dependencies => [ depends_on('local_files') ],
332 sub build_config_path_service {
335 return Bread::Board::BlockInjection->new(
336 lifecycle => 'Singleton',
337 name => 'config_path',
341 my $path = $s->param('path');
342 my $prefix = $s->param('prefix');
344 my ( $extension ) = ( $path =~ m{\.(.{1,4})$} );
347 $path =~ s{[\/\\]$}{};
351 return [ $path, $extension ];
353 dependencies => [ depends_on('prefix'), depends_on('path') ],
357 sub build_config_local_suffix_service {
360 return Bread::Board::BlockInjection->new(
361 lifecycle => 'Singleton',
362 name => 'config_local_suffix',
365 my $suffix = Catalyst::Utils::env_value( $s->param('application_name'), 'CONFIG_LOCAL_SUFFIX' ) || $self->config_local_suffix;
369 dependencies => [ depends_on('application_name') ],
377 prefix => $_ eq 'Component' ? '' : $_ . '::',
378 values => delete $config->{ lc $_ } || delete $config->{ $_ }
380 grep { ref $config->{ lc $_ } || ref $config->{ $_ } }
381 qw( Component Model M View V Controller C Plugin )
384 foreach my $comp ( @components ) {
385 my $prefix = $comp->{ prefix };
386 foreach my $element ( keys %{ $comp->{ values } } ) {
387 $config->{ "$prefix$element" } = $comp->{ values }->{ $element };
392 sub _config_substitutions {
393 my ( $self, $name, $subs, $arg ) = @_;
395 $subs->{ HOME } ||= sub { shift->path_to( '' ); };
399 if (! defined($ENV{$v})) {
400 Catalyst::Exception->throw( message =>
401 "Missing environment variable: $v" );
407 $subs->{ path_to } ||= sub { shift->path_to( @_ ); };
408 $subs->{ literal } ||= sub { return $_[ 1 ]; };
409 my $subsre = join( '|', keys %$subs );
411 $arg =~ s{__($subsre)(?:\((.+?)\))?__}{ $subs->{ $1 }->( $name, $2 ? split( /,/, $2 ) : () ) }eg;
415 sub get_component_from_sub_container {
416 my ( $self, $sub_container_name, $name, $c, @args ) = @_;
418 my $sub_container = $self->get_sub_container( $sub_container_name );
421 my $default = $sub_container->default_component;
423 return $sub_container->get_component( $default, $c, @args )
424 if $default && $sub_container->has_service( $default );
426 # FIXME - should I be calling $c->log->warn here?
427 # this is never a controller, so this is safe
428 $c->log->warn( "Calling \$c->$sub_container_name() is not supported unless you specify one of:" );
429 $c->log->warn( "* \$c->config(default_$sub_container_name => 'the name of the default $sub_container_name to use')" );
430 $c->log->warn( "* \$c->stash->{current_$sub_container_name} # the name of the view to use for this request" );
431 $c->log->warn( "* \$c->stash->{current_${sub_container_name}_instance} # the instance of the $sub_container_name to use for this request" );
436 return $sub_container->get_component_regexp( $name, $c, @args )
439 return $sub_container->get_component( $name, $c, @args )
440 if $sub_container->has_service( $name );
443 "Attempted to use $sub_container_name '$name', " .
444 "but it does not exist"
451 my ( $self, $component, $c, @args ) = @_;
452 my ( $type, $name ) = _get_component_type_name($component);
455 return $self->get_component_from_sub_container(
456 $type, $name, $c, @args
459 my $query = ref $component
464 for my $subcontainer_name (qw/model view controller/) {
465 my $subcontainer = $self->get_sub_container( $subcontainer_name );
466 my @components = $subcontainer->get_service_list;
467 @result = grep { m{$component} } @components;
469 return map { $subcontainer->get_component( $_, $c, @args ) } @result
473 # FIXME - I guess I shouldn't be calling $c->components here
474 # one last search for things like $c->comp(qr/::M::/)
475 @result = $self->find_component_regexp(
476 $c->components, $component, $c, @args
477 ) if !@result and ref $component;
479 # it expects an empty list on failed searches
483 sub find_component_regexp {
484 my ( $self, $components, $component, @args ) = @_;
487 my @components = grep { m{$component} } keys %{ $components };
490 my ($type, $name) = _get_component_type_name($_);
492 push @result, $self->get_component_from_sub_container(
500 # FIXME sorry for the name again :)
501 sub get_components_types {
505 for my $sub_container_name (qw/model view controller/) {
506 my $sub_container = $self->get_sub_container($sub_container_name);
507 for my $service ( $sub_container->get_service_list ) {
508 my $comp = $self->resolve(service => $service);
509 my $compname = ref $comp || $comp;
510 my $type = ref $comp ? 'instance' : 'class';
511 push @comps_types, [ $compname, $type ];
518 sub get_all_components {
523 map { $_ => $self->get_sub_container($_) } qw(model view controller)
526 for my $container (keys %$containers) {
527 for my $component ($containers->{$container}->get_service_list) {
528 my $comp = $containers->{$container}->resolve(
529 service => $component
531 my $comp_name = ref $comp || $comp;
532 $components{$comp_name} = $comp;
536 return lock_hash %components;
540 my ( $self, $component, $class ) = @_;
541 my ( $type, $name ) = _get_component_type_name($component);
545 $self->get_sub_container($type)->add_service(
546 Catalyst::IOC::BlockInjection->new(
547 lifecycle => 'Singleton', # FIXME?
549 block => sub { $self->setup_component( $component, $class ) },
554 # FIXME: should this sub exist?
555 # should it be moved to Catalyst::Utils,
556 # or replaced by something already existing there?
557 sub _get_component_type_name {
558 my ( $component ) = @_;
560 my @parts = split /::/, $component;
562 while (my $type = shift @parts) {
563 return ('controller', join '::', @parts)
564 if $type =~ /^(c|controller)$/i;
566 return ('model', join '::', @parts)
567 if $type =~ /^(m|model)$/i;
569 return ('view', join '::', @parts)
570 if $type =~ /^(v|view)$/i;
573 return (undef, $component);
576 # FIXME ugly and temporary
577 # Just moved it here the way it was, so we can work on it here in the container
578 sub setup_component {
579 my ( $self, $component, $class ) = @_;
581 unless ( $component->can( 'COMPONENT' ) ) {
585 # FIXME I know this isn't the "Dependency Injection" way of doing things,
587 my $suffix = Catalyst::Utils::class2classsuffix( $component );
588 my $config = $self->resolve(service => 'config')->{ $suffix } || {};
590 # Stash catalyst_component_name in the config here, so that custom COMPONENT
591 # methods also pass it. local to avoid pointlessly shitting in config
592 # for the debug screen, as $component is already the key name.
593 local $config->{catalyst_component_name} = $component;
595 my $instance = eval { $component->COMPONENT( $class, $config ); };
597 if ( my $error = $@ ) {
599 Catalyst::Exception->throw(
600 message => qq/Couldn't instantiate component "$component", "$error"/
603 elsif (!blessed $instance) {
604 my $metaclass = Moose::Util::find_meta($component);
605 my $method_meta = $metaclass->find_method_by_name('COMPONENT');
606 my $component_method_from = $method_meta->associated_metaclass->name;
607 my $value = defined($instance) ? $instance : 'undef';
608 Catalyst::Exception->throw(
610 qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./
617 sub expand_component_module {
618 my ( $class, $module ) = @_;
619 return Devel::InnerPackage::list_packages( $module );
622 sub locate_components {
623 my ( $self, $class, $config ) = @_;
625 my @paths = qw( ::Controller ::C ::Model ::M ::View ::V );
627 my $locator = Module::Pluggable::Object->new(
628 search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
632 # XXX think about ditching this sort entirely
633 my @comps = sort { length $a <=> length $b } $locator->plugins;
638 sub setup_components {
639 my ( $self, $class ) = @_;
641 # FIXME - should I get config as an argument, and throw the exception in
643 my $config = $self->resolve(service => 'config')->{ setup_components };
645 Catalyst::Exception->throw(
646 qq{You are using search_extra config option. That option is\n} .
647 qq{deprecated, please refer to the documentation for\n} .
648 qq{other ways of achieving the same results.\n}
649 ) if delete $config->{ search_extra };
651 my @comps = $self->locate_components( $class, $config );
652 my %comps = map { $_ => 1 } @comps;
653 my $deprecatedcatalyst_component_names = 0;
655 for my $component ( @comps ) {
657 # We pass ignore_loaded here so that overlay files for (e.g.)
658 # Model::DBI::Schema sub-classes are loaded - if it's in @comps
659 # we know M::P::O found a file on disk so this is safe
661 Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
664 for my $component (@comps) {
665 $self->add_component( $component, $class );
666 # FIXME - $instance->expand_modules() is broken
667 my @expanded_components = $self->expand_component_module( $component );
670 !$deprecatedcatalyst_component_names &&
671 ($deprecatedcatalyst_component_names = $component =~ m/::[CMV]::/) ||
672 ($deprecatedcatalyst_component_names = grep { /::[CMV]::/ } @expanded_components)
674 # FIXME - should I be calling warn here?
675 $class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}.
676 qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n}
680 for my $component (@expanded_components) {
681 $self->add_component( $component, $class )
682 unless $comps{$component};
686 $self->get_sub_container('model')->make_single_default;
687 $self->get_sub_container('view')->make_single_default;
698 Catalyst::Container - IOC for Catalyst components
708 =head2 build_model_subcontainer
710 Container that stores all models.
712 =head2 build_view_subcontainer
714 Container that stores all views.
716 =head2 build_controller_subcontainer
718 Container that stores all controllers.
722 =head2 build_application_name_service
724 Name of the application (such as MyApp).
726 =head2 build_driver_service
728 Config options passed directly to the driver being used.
730 =head2 build_file_service
734 =head2 build_substitutions_service
736 Executes all the substitutions in config. See L</_config_substitutions> method.
738 =head2 build_extensions_service
740 =head2 build_prefix_service
742 =head2 build_path_service
744 =head2 build_config_service
746 =head2 build_raw_config_service
748 =head2 build_global_files_service
750 =head2 build_local_files_service
752 =head2 build_global_config_service
754 =head2 build_local_config_service
756 =head2 build_config_path_service
758 =head2 build_config_local_suffix_service
760 Determines the suffix of files used to override the main config. By default
761 this value is C<local>, which will load C<myapp_local.conf>. The suffix can
762 be specified in the following order of preference:
766 =item * C<$ENV{ MYAPP_CONFIG_LOCAL_SUFFIX }>
768 =item * C<$ENV{ CATALYST_CONFIG_LOCAL_SUFFIX }>
772 The first one of these values found replaces the default of C<local> in the
773 name of the local config file to be loaded.
775 For example, if C< $ENV{ MYAPP_CONFIG_LOCAL_SUFFIX }> is set to C<testing>,
776 ConfigLoader will try and load C<myapp_testing.conf> instead of
779 =head2 get_component_from_sub_container($sub_container, $name, $c, @args)
781 Looks for components in a given subcontainer (such as controller, model or view), and returns the searched component. If $name is undef, it returns the default component (such as default_view, if $sub_container is 'view'). If $name is a regexp, it returns an array of matching components. Otherwise, it looks for the component with name $name.
783 =head2 get_components_types
785 =head2 get_all_components
787 Fetches all the components, in each of the sub_containers model, view and controller, and returns a readonly hash. The keys are the class names, and the values are the blessed objects. This is what is returned by $c->components.
791 Adds a component to the appropriate subcontainer. The subcontainer is guessed by the component name given.
793 =head2 find_component
795 Searches for components in all containers. If $component is the full class name, the subcontainer is guessed, and it gets the searched component in there. Otherwise, it looks for a component with that name in all subcontainers. If $component is a regexp, it calls the method below, find_component_regexp, and matches all components against that regexp.
797 =head2 find_component_regexp
799 Finds components that match a given regexp. Used internally, by find_component.
801 =head2 setup_component
805 =head2 _config_substitutions
807 This method substitutes macros found with calls to a function. There are a
808 number of default macros:
812 =item * C<__HOME__> - replaced with C<$c-E<gt>path_to('')>
814 =item * C<__ENV(foo)__> - replaced with the value of C<$ENV{foo}>
816 =item * C<__path_to(foo/bar)__> - replaced with C<$c-E<gt>path_to('foo/bar')>
818 =item * C<__literal(__FOO__)__> - leaves __FOO__ alone (allows you to use
819 C<__DATA__> as a config value, for example)
823 The parameter list is split on comma (C<,>). You can override this method to
824 do your own string munging, or you can define your own macros in
825 C<MyApp-E<gt>config-E<gt>{ 'Plugin::ConfigLoader' }-E<gt>{ substitutions }>.
828 MyApp->config->{ 'Plugin::ConfigLoader' }->{ substitutions } = {
829 baz => sub { my $c = shift; qux( @_ ); }
832 The above will respond to C<__baz(x,y)__> in config strings.
834 =head2 $c->expand_component_module( $component, $setup_component_config )
836 Components found by C<locate_components> will be passed to this method, which
837 is expected to return a list of component (package) names to be set up.
839 =head2 locate_components( $setup_component_config )
841 This method is meant to provide a list of component modules that should be
842 setup for the application. By default, it will use L<Module::Pluggable>.
844 Specify a C<setup_components> config option to pass additional options directly
845 to L<Module::Pluggable>.
849 Catalyst Contributors, see Catalyst.pm
853 This library is free software. You can redistribute it and/or modify it under
854 the same terms as Perl itself.