it should at least compile
[catagits/Catalyst-Runtime.git] / lib / Catalyst / IOC / Container.pm
index 051f758..0635964 100644 (file)
@@ -4,10 +4,12 @@ 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 ();
@@ -82,6 +84,16 @@ sub BUILD {
 
     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_component_subcontainer
     );
@@ -91,16 +103,20 @@ sub BUILD {
     );
 
     $self->add_sub_container(
-        $self->build_view_subcontainer(
-            default_component => $config->{default_view},
-        )
+        $self->build_view_subcontainer( @default_view )
     );
 
     $self->add_sub_container(
-        $self->build_model_subcontainer(
-            default_component => $config->{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 {
@@ -135,6 +151,45 @@ sub build_component_subcontainer {
     );
 }
 
+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('application_name');
+            my $home;
+
+            if ( my $env = Catalyst::Utils::env_value( $class, 'HOME' ) ) {
+                $home = $env;
+            }
+
+            $home ||= Catalyst::Utils::home($class);
+
+            return $home;
+        },
+        dependencies => [ depends_on('application_name') ],
+    );
+}
+
+# FIXME: very ambiguous - maybe root_dir?
+sub build_root_service {
+    my $self = shift;
+
+    return Bread::Board::BlockInjection->new(
+        lifecycle => 'Singleton',
+        name => 'root',
+        block => sub {
+            my $self = shift;
+
+            return Path::Class::Dir->new( $self->param('home') )->subdir('root');
+        },
+        dependencies => [ depends_on('home') ],
+    );
+}
+
 sub build_application_name_service {
     my $self = shift;
 
@@ -441,6 +496,21 @@ sub setup_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.)
@@ -472,9 +542,6 @@ sub setup_components {
                 unless $comps{$component};
         }
     }
-
-    $self->get_sub_container('model')->make_single_default;
-    $self->get_sub_container('view')->make_single_default;
 }
 
 sub _fix_syntax {
@@ -578,7 +645,7 @@ sub find_component {
     }
 
     # one last search for things like $c->comp(qr/::M::/)
-    @result = $self->find_component_regexp(
+    @result = $self->_find_component_regexp(
         $component, @args
     ) if !@result and ref $component;
 
@@ -586,54 +653,41 @@ sub find_component {
     return @result;
 }
 
-sub find_component_regexp {
-    my ( $self, $component, @args ) = @_;
+sub _find_component_regexp {
+    my ( $self, $component, $ctx, @args ) = @_;
     my @result;
 
-    my @components = grep { m{$component} } keys %{ $self->get_all_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 - t0m, how do you feel about this name?
-# also, do you think I should draw it here, or just return the data structure?
-sub get_components_names_types {
-    my ( $self ) = @_;
-    my @comps_names_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     = $sub_container->resolve(service => $service);
-            my $compname = ref $comp || $comp;
-            my $type     = ref $comp ? 'instance' : 'class';
-            push @comps_names_types, [ $compname, $type ];
-        }
-    }
-
-    return @comps_names_types;
-}
-
 sub get_all_components {
-    my $self = shift;
+    my ($self, $class) = @_;
     my %components;
 
-    my $container = $self->get_sub_container('component');
+    # 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 $component ($container->get_service_list) {
-        my $comp = $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);
+        }
     }
 
     return lock_hash %components;
@@ -645,27 +699,47 @@ sub add_component {
 
     return unless $type;
 
+    # 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}";
 
-    $self->get_sub_container('component')->add_service(
+    $instance_container->add_service(
         Catalyst::IOC::ConstructorInjection->new(
             name      => $component_service_name,
+            catalyst_component_name => $component,
             class     => $component,
             lifecycle => 'Singleton',
             dependencies => [
                 depends_on( '/application_name' ),
-                depends_on( '/config' ),
             ],
-        )
+        ),
     );
-
-    $self->get_sub_container($type)->add_service(
+    # 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( "/component/$component_service_name" ),
             ],
-            block => sub { return shift->param($component_service_name) },
+            block => sub { shift->param($component_service_name) },
         )
     );
 }
@@ -675,21 +749,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 {
@@ -713,21 +782,30 @@ 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<build_model_subcontainer>, but for views.
 
 =head2 build_controller_subcontainer
 
-Container that stores all controllers.
+Same as L<build_model_subcontainer>, but for controllers.
 
-=head1 Building Services
+=head1 Methods for Building Services
 
 =head2 build_application_name_service
 
@@ -761,12 +839,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
-C<MyApp-E<gt>config-E<gt>{ 'Plugin::ConfigLoader' }-E<gt>{ substitutions }>.
+C<< <MyApp->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.
 
@@ -776,7 +856,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.
 
@@ -853,40 +933,30 @@ to L<Module::Pluggable>.
 
 =head2 get_component_from_sub_container($sub_container, $name, $c, @args)
 
-Looks for components in a given subcontainer (such as controller, model or
+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_components_names_types
-
-Gets all components from all containers and returns them as an array of
-arrayrefs containing the component name and the component type (i.e., whether
-it's an instance or a class).
-
 =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
+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
+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.
-
-=head2 find_component_regexp
-
-Finds components that match a given regexp. Used internally, by find_component.
+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 expand_component_module
 
@@ -895,6 +965,9 @@ 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