X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst%2FIOC%2FContainer.pm;h=cb82f697f33ec7e45bfae1e95c63726cc00adefc;hp=994998cf671140b22f1d21c2edad9ca3d5095632;hb=1a5adaee236dda2152a9d0fb1ca27d08f3f92777;hpb=bbb306a9630de32362823ccc0138fdb17adb520b diff --git a/lib/Catalyst/IOC/Container.pm b/lib/Catalyst/IOC/Container.pm index 994998c..cb82f69 100644 --- a/lib/Catalyst/IOC/Container.pm +++ b/lib/Catalyst/IOC/Container.pm @@ -1,13 +1,16 @@ package Catalyst::IOC::Container; -use Bread::Board; +use Bread::Board qw/depends_on/; use Moose; use Config::Any; use Data::Visitor::Callback; use Catalyst::Utils (); +use List::Util qw(first); use Devel::InnerPackage (); use Hash::Util qw/lock_hash/; use MooseX::Types::LoadableClass qw/ LoadableClass /; use Moose::Util; +use Scalar::Util qw/refaddr/; +use Catalyst::IOC::BlockInjection; use Catalyst::IOC::ConstructorInjection; use Module::Pluggable::Object (); use namespace::autoclean; @@ -38,12 +41,6 @@ has substitutions => ( default => sub { +{} }, ); -has application_name => ( - is => 'ro', - isa => 'Str', - default => 'MyApp', -); - has sub_container_class => ( isa => LoadableClass, is => 'ro', @@ -63,7 +60,7 @@ sub BUILD { substitutions file driver - application_name + catalyst_application prefix extensions path @@ -73,31 +70,49 @@ sub BUILD { local_files global_config local_config + class_config config_local_suffix config_path locate_components + home + root_dir /; + my $config = $self->resolve( service => 'config' ); + + # don't force default_component to be undef if the config wasn't set + my @default_view = $config->{default_view} + ? ( default_component => $config->{default_view} ) + : ( ) + ; + my @default_model = $config->{default_model} + ? ( default_component => $config->{default_model} ) + : ( ) + ; + $self->add_sub_container( - $self->build_controller_subcontainer + $self->build_component_subcontainer ); - # FIXME - the config should be merged at this point - my $config = $self->resolve( service => 'config' ); - my $default_view = $params->{default_view} || $config->{default_view}; - my $default_model = $params->{default_model} || $config->{default_model}; + $self->add_sub_container( + $self->build_controller_subcontainer + ); $self->add_sub_container( - $self->build_view_subcontainer( - default_component => $default_view, - ) + $self->build_view_subcontainer( @default_view ) ); $self->add_sub_container( - $self->build_model_subcontainer( - default_component => $default_model, - ) + $self->build_model_subcontainer( @default_model ) ); + + { + no strict 'refs'; + no warnings 'once'; + my $class = ref $self; + ${ $class . '::customise_container' }->($self) + if ${ $class . '::customise_container' }; + } } sub build_model_subcontainer { @@ -124,10 +139,60 @@ sub build_controller_subcontainer { ); } -sub build_application_name_service { +sub build_component_subcontainer { + my $self = shift; + + return Bread::Board::Container->new( + name => 'component', + ); +} + +sub build_home_service { + my $self = shift; + + return Bread::Board::BlockInjection->new( + lifecycle => 'Singleton', + name => 'home', + block => sub { + my $self = shift; + my $class = $self->param('catalyst_application'); + + if ( my $env = Catalyst::Utils::env_value( $class, 'HOME' ) ) { + return $env; + } + + if ( my $home = $self->param('home_flag') ) { + return $home; + } + + return Catalyst::Utils::home($class); + }, + parameters => { + home_flag => { is => 'ro', isa => 'Str|Undef', required => 0 } + }, + dependencies => [ depends_on('catalyst_application') ], + ); +} + +sub build_root_dir_service { + my $self = shift; + + return Bread::Board::BlockInjection->new( + lifecycle => 'Singleton', + name => 'root_dir', + block => sub { + my $self = shift; + + return Path::Class::Dir->new( $self->param('home') )->subdir('root'); + }, + dependencies => [ depends_on('home') ], + ); +} + +sub build_catalyst_application_service { my $self = shift; - return Bread::Board::Literal->new( name => 'application_name', value => $self->application_name ); + return Bread::Board::Literal->new( name => 'catalyst_application', value => $self->name ); } sub build_driver_service { @@ -167,9 +232,9 @@ sub build_prefix_service { lifecycle => 'Singleton', name => 'prefix', block => sub { - return Catalyst::Utils::appprefix( shift->param('application_name') ); + return Catalyst::Utils::appprefix( shift->param('catalyst_application') ); }, - dependencies => [ depends_on('application_name') ], + dependencies => [ depends_on('catalyst_application') ], ); } @@ -182,11 +247,11 @@ sub build_path_service { block => sub { my $s = shift; - return Catalyst::Utils::env_value( $s->param('application_name'), 'CONFIG' ) + return Catalyst::Utils::env_value( $s->param('catalyst_application'), 'CONFIG' ) || $s->param('file') - || $s->param('application_name')->path_to( $s->param('prefix') ); + || $s->param('catalyst_application')->path_to( $s->param('prefix') ); }, - dependencies => [ depends_on('file'), depends_on('application_name'), depends_on('prefix') ], + dependencies => [ depends_on('file'), depends_on('catalyst_application'), depends_on('prefix') ], ); } @@ -202,13 +267,13 @@ sub build_config_service { my $v = Data::Visitor::Callback->new( plain_value => sub { return unless defined $_; - return $self->_config_substitutions( $s->param('application_name'), $s->param('substitutions'), $_ ); + return $self->_config_substitutions( $s->param('catalyst_application'), $s->param('substitutions'), $_ ); } ); $v->visit( $s->param('raw_config') ); }, - dependencies => [ depends_on('application_name'), depends_on('raw_config'), depends_on('substitutions') ], + dependencies => [ depends_on('catalyst_application'), depends_on('raw_config'), depends_on('substitutions') ], ); } @@ -224,15 +289,17 @@ sub build_raw_config_service { my @global = @{$s->param('global_config')}; my @locals = @{$s->param('local_config')}; - my $config = {}; + my $config = $s->param('class_config'); + for my $cfg (@global, @locals) { for (keys %$cfg) { $config = Catalyst::Utils::merge_hashes( $config, $cfg->{$_} ); } } + return $config; }, - dependencies => [ depends_on('global_config'), depends_on('local_config') ], + dependencies => [ depends_on('global_config'), depends_on('local_config'), depends_on('class_config') ], ); } @@ -290,6 +357,26 @@ sub build_local_files_service { ); } +sub build_class_config_service { + my $self = shift; + + return Bread::Board::BlockInjection->new( + lifecycle => 'Singleton', + name => 'class_config', + block => sub { + my $s = shift; + my $app = $s->param('catalyst_application'); + + # Container might be called outside Catalyst context + return {} unless Class::MOP::is_class_loaded($app); + + # config might not have been defined + return $app->config || {}; + }, + dependencies => [ depends_on('catalyst_application') ], + ); +} + sub build_global_config_service { my $self = shift; @@ -363,11 +450,11 @@ sub build_config_local_suffix_service { name => 'config_local_suffix', block => sub { my $s = shift; - my $suffix = Catalyst::Utils::env_value( $s->param('application_name'), 'CONFIG_LOCAL_SUFFIX' ) || $self->config_local_suffix; + my $suffix = Catalyst::Utils::env_value( $s->param('catalyst_application'), 'CONFIG_LOCAL_SUFFIX' ) || $self->config_local_suffix; return $suffix; }, - dependencies => [ depends_on('application_name') ], + dependencies => [ depends_on('catalyst_application') ], ); } @@ -379,7 +466,7 @@ sub build_locate_components_service { name => 'locate_components', block => sub { my $s = shift; - my $class = $s->param('application_name'); + my $class = $s->param('catalyst_application'); my $config = $s->param('config')->{ setup_components }; Catalyst::Exception->throw( @@ -397,17 +484,32 @@ sub build_locate_components_service { return [ $locator->plugins ]; }, - dependencies => [ depends_on('application_name'), depends_on('config') ], + dependencies => [ depends_on('catalyst_application'), depends_on('config') ], ); } sub setup_components { my $self = shift; - my $class = $self->resolve( service => 'application_name' ); + my $class = $self->resolve( service => 'catalyst_application' ); my @comps = @{ $self->resolve( service => 'locate_components' ) }; my %comps = map { $_ => 1 } @comps; my $deprecatedcatalyst_component_names = 0; + my $app_locate_components_addr = refaddr( + $class->can('locate_components') + ); + my $cat_locate_components_addr = refaddr( + Catalyst->can('locate_components') + ); + + if ($app_locate_components_addr != $cat_locate_components_addr) { + # FIXME - why not just say: @comps = $class->locate_components() ? + $class->log->warn(qq{You have overridden locate_components. That } . + qq{no longer works. Please refer to the documentation to achieve } . + qq{similar results.\n} + ); + } + for my $component ( @comps ) { # We pass ignore_loaded here so that overlay files for (e.g.) @@ -418,7 +520,7 @@ sub setup_components { } for my $component (@comps) { - $self->add_component( $component, $class ); + $self->add_component( $component ); # FIXME - $instance->expand_modules() is broken my @expanded_components = $self->expand_component_module( $component ); @@ -428,19 +530,17 @@ sub setup_components { ($deprecatedcatalyst_component_names = grep { /::[CMV]::/ } @expanded_components) ) { # FIXME - should I be calling warn here? + # Maybe it's time to remove it, or become fatal $class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}. qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n} ); } for my $component (@expanded_components) { - $self->add_component( $component, $class ) + $self->add_component( $component ) unless $comps{$component}; } } - - $self->get_sub_container('model')->make_single_default; - $self->get_sub_container('view')->make_single_default; } sub _fix_syntax { @@ -521,12 +621,12 @@ sub get_component_from_sub_container { } sub find_component { - my ( $self, $component, $c, @args ) = @_; + my ( $self, $component, @args ) = @_; my ( $type, $name ) = _get_component_type_name($component); my @result; return $self->get_component_from_sub_container( - $type, $name, $c, @args + $type, $name, @args ) if $type; my $query = ref $component @@ -539,70 +639,53 @@ sub find_component { my @components = $subcontainer->get_service_list; @result = grep { m{$component} } @components; - return map { $subcontainer->get_component( $_, $c, @args ) } @result + return map { $subcontainer->get_component( $_, @args ) } @result if @result; } - # FIXME - I guess I shouldn't be calling $c->components here # one last search for things like $c->comp(qr/::M::/) - @result = $self->find_component_regexp( - $c->components, $component, $c, @args + @result = $self->_find_component_regexp( + $component, @args ) if !@result and ref $component; # it expects an empty list on failed searches return @result; } -sub find_component_regexp { - my ( $self, $components, $component, @args ) = @_; +sub _find_component_regexp { + my ( $self, $component, $ctx, @args ) = @_; my @result; - my @components = grep { m{$component} } keys %{ $components }; + my @components = grep { m{$component} } keys %{ $self->get_all_components($ctx) }; for (@components) { my ($type, $name) = _get_component_type_name($_); push @result, $self->get_component_from_sub_container( - $type, $name, @args + $type, $name, $ctx, @args ) if $type; } return @result; } -# FIXME sorry for the name again :) -sub get_components_types { - my ( $self ) = @_; - my @comps_types; - - for my $sub_container_name (qw/model view controller/) { - my $sub_container = $self->get_sub_container($sub_container_name); - for my $service ( $sub_container->get_service_list ) { - my $comp = $self->resolve(service => $service); - my $compname = ref $comp || $comp; - my $type = ref $comp ? 'instance' : 'class'; - push @comps_types, [ $compname, $type ]; - } - } - - return @comps_types; -} - sub get_all_components { - my $self = shift; + my ($self, $class) = @_; my %components; - my $containers = { - map { $_ => $self->get_sub_container($_) } qw(model view controller) - }; + # FIXME - if we're getting from these containers, we need to either: + # - pass 'ctx' and 'accept_context_args' OR + # - make these params optional + # big problem when setting up the dispatcher - this method is called + # as $container->get_all_components('MyApp'). What to do with Request + # life cycles? + foreach my $type (qw/model view controller /) { + my $container = $self->get_sub_container($type); - for my $container (keys %$containers) { - for my $component ($containers->{$container}->get_service_list) { - my $comp = $containers->{$container}->resolve( - service => $component - ); - my $comp_name = ref $comp || $comp; - $components{$comp_name} = $comp; + for my $component ($container->get_service_list) { + my $comp_service = $container->get_service($component); + + $components{$comp_service->catalyst_component_name} = $comp_service->get(ctx => $class); } } @@ -610,30 +693,52 @@ sub get_all_components { } sub add_component { - my ( $self, $component, $class ) = @_; + my ( $self, $component ) = @_; my ( $type, $name ) = _get_component_type_name($component); return unless $type; - $self->get_sub_container($type)->add_service( + # The 'component' sub-container will create the object, and store it's + # instance, which, by default, will live throughout the application. + # The model/view/controller sub-containers only reference the instance + # held in the aforementioned sub-container, and execute the ACCEPT_CONTEXT + # sub every time they are called, when it exists. + my $instance_container = $self->get_sub_container('component'); + my $accept_context_container = $self->get_sub_container($type); + + # Custom containers might have added the service already + # We don't want to override that + return if $accept_context_container->has_service( $name ); + + my $component_service_name = "${type}_${name}"; + + $instance_container->add_service( Catalyst::IOC::ConstructorInjection->new( - name => $name, + name => $component_service_name, + catalyst_component_name => $component, class => $component, + lifecycle => 'Singleton', + dependencies => [ + depends_on( '/catalyst_application' ), + ], + ), + ); + # XXX - FIXME - We have to explicitly build the service here, + # causing the COMPONENT method to be called early here, as otherwise + # if the component method defines other classes (e.g. the + # ACCEPT_CONTEXT injection Model::DBIC::Schema does) + # then they won't be found by Devel::InnerPackage + # see also t/aggregate/unit_core_component_loading.t + $instance_container->get_service($component_service_name)->get; + + $accept_context_container->add_service( + Catalyst::IOC::BlockInjection->new( + name => $name, + catalyst_component_name => $component, dependencies => [ - depends_on( '/application_name' ), - depends_on( '/config' ), + depends_on( "/component/$component_service_name" ), ], - parameters => { - suffix => { - isa => 'Str', - default => Catalyst::Utils::class2classsuffix( $component ), - }, - accept_context_args => { - isa => 'ArrayRef|Undef', - required => 0, - default => undef, - }, - }, + block => sub { shift->param($component_service_name) }, ) ); } @@ -643,21 +748,16 @@ sub add_component { # or replaced by something already existing there? sub _get_component_type_name { my ( $component ) = @_; + my $result; - my @parts = split /::/, $component; - - while (my $type = shift @parts) { - return ('controller', join '::', @parts) - if $type =~ /^(c|controller)$/i; - - return ('model', join '::', @parts) - if $type =~ /^(m|model)$/i; - - return ('view', join '::', @parts) - if $type =~ /^(v|view)$/i; + while ( !$result and (my $index = index $component, '::') > 0 ) { + my $type = lc substr $component, 0, $index; + $component = substr $component, $index + 2; + $result = first { $type eq $_ or $type eq substr($_, 0, 1) } + qw{ model view controller }; } - return (undef, $component); + return ($result, $component); } sub expand_component_module { @@ -665,6 +765,8 @@ sub expand_component_module { return Devel::InnerPackage::list_packages( $module ); } +__PACKAGE__->meta->make_immutable; + 1; __END__ @@ -681,26 +783,46 @@ Catalyst::Container - IOC for Catalyst components =head1 METHODS -=head1 Building Containers +=head1 Methods for Building Containers + +=head2 build_component_subcontainer + +Container that stores all components, i.e. all models, views and controllers +together. Each service is an instance of the actual component, and by default +it lives while the application is running. Retrieving components from this +sub-container will instantiate the component, if it hasn't been instantiated +already, but will not execute ACCEPT_CONTEXT. =head2 build_model_subcontainer -Container that stores all models. +Container that stores references for all models that are inside the components +sub-container. Retrieving a model triggers ACCEPT_CONTEXT, if it exists. =head2 build_view_subcontainer -Container that stores all views. +Same as L, but for views. =head2 build_controller_subcontainer -Container that stores all controllers. +Same as L, but for controllers. -=head1 Building Services +=head1 Methods for Building Services -=head2 build_application_name_service +=head2 build_catalyst_application_service Name of the application (such as MyApp). +=head2 build_home_service + +The application home directory. All the files (including classes, scripts, etc) +created for this application are in this directory, or in a sub-directory below +this one. + +=head2 build_root_dir_service + +Inside the application home (as explained in L), there is +a root directory. This is where all templates and static files are. + =head2 build_driver_service Config options passed directly to the driver being used. @@ -729,12 +851,14 @@ C<__DATA__> as a config value, for example) The parameter list is split on comma (C<,>). You can override this method to do your own string munging, or you can define your own macros in -Cconfig-E{ 'Plugin::ConfigLoader' }-E{ substitutions }>. +C<< config( 'Plugin::ConfigLoader' => { substitutions => { ... } } ) >>. Example: - MyApp->config->{ 'Plugin::ConfigLoader' }->{ substitutions } = { - baz => sub { my $c = shift; qux( @_ ); } - } + MyApp->config( 'Plugin::ConfigLoader' => { + substitutions => { + baz => sub { my $c = shift; qux( @_ ); }, + }, + }); The above will respond to C<__baz(x,y)__> in config strings. @@ -744,7 +868,7 @@ Config::Any's available config file extensions (e.g. xml, json, pl, etc). =head2 build_prefix_service -The prefix, based on the application name, that will be used to lookup the +The prefix, based on the application name, that will be used to look-up the config files (which will be in the format $prefix.$extension). If the app is MyApp::Foo, the prefix will be myapp_foo. @@ -777,6 +901,11 @@ Reads config from global_files. Reads config from local_files. +=head2 build_class_config_service + +Reads config set from the application's class attribute config, +i.e. MyApp->config( name => 'MyApp', ... ) + =head2 build_config_path_service Splits the path to the config file, and returns on array ref containing @@ -816,33 +945,41 @@ to L. =head2 get_component_from_sub_container($sub_container, $name, $c, @args) -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. - -=head2 get_components_types +Looks for components in a given sub-container (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. =head2 get_all_components -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. +Fetches all the components, in each of the sub_containers model, view and +controller, and returns a read-only hash. The keys are the class names, and +the values are the blessed objects. This is what is returned by $c->components. =head2 add_component -Adds a component to the appropriate subcontainer. The subcontainer is guessed by the component name given. +Adds a component to the appropriate sub-container. The sub-container is guessed +by the component name given. =head2 find_component -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. +Searches for components in all containers. If $component is the full class +name, the sub-container is guessed, and it gets the searched component in there. +Otherwise, it looks for a component with that name in all sub-containers. If +$component is a regexp it calls _find_component_regexp and matches all +components against that regexp. -=head2 find_component_regexp - -Finds components that match a given regexp. Used internally, by find_component. - -=head2 $c->expand_component_module( $component, $setup_component_config ) +=head2 expand_component_module Components found by C will be passed to this method, which is expected to return a list of component (package) names to be set up. =head2 setup_components +Uses locate_components service to list the components, and adds them to the +appropriate sub-containers, using add_component(). + =head1 AUTHORS Catalyst Contributors, see Catalyst.pm