removing noise (comments and warnings)

[catagits/Catalyst-Runtime.git] / lib / Catalyst / IOC / Container.pm

diff --git a/lib/Catalyst/IOC/Container.pm b/lib/Catalyst/IOC/Container.pm
index 29c39be..1e9ec84 100644 (file)
--- a/lib/Catalyst/IOC/Container.pm
+++ b/lib/Catalyst/IOC/Container.pm
@@ -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 ();
@@ -107,6 +109,14 @@ sub BUILD {
     $self->add_sub_container(
         $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 {
@@ -447,6 +457,20 @@ 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) {
+        $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.)
@@ -590,16 +614,16 @@ sub find_component {
 }
 
 sub _find_component_regexp {
-    my ( $self, $component, @args ) = @_;
+    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;
     }
 
@@ -607,17 +631,23 @@ sub _find_component_regexp {
 }
 
 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;
@@ -629,8 +659,6 @@ sub add_component {
 
     return unless $type;
 
-    my $component_service_name = "${type}_${name}";
-
     # 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
@@ -639,30 +667,34 @@ sub add_component {
     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      => $component_service_name,
+            catalyst_component_name => $component,
             class     => $component,
             lifecycle => 'Singleton',
             dependencies => [
                 depends_on( '/application_name' ),
-                depends_on( '/config' ),
             ],
         )
-    ) unless $instance_container->has_service( $component_service_name );
-    # ^ custom containers might have added the service already.
-    # we don't want to override that.
+    );
 
     $accept_context_container->add_service(
         Catalyst::IOC::BlockInjection->new(
             name         => $name,
+            catalyst_component_name => $component,
             dependencies => [
                 depends_on( "/component/$component_service_name" ),
             ],
             block => sub { shift->param($component_service_name) },
         )
-    ) unless $accept_context_container->has_service( $name );
-    # ^ same as above
+    );
 }
 
 # FIXME: should this sub exist?
@@ -670,23 +702,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 (scalar @parts > 1) {
-        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 {