Merge branch 'master' into gsoc_breadboard
[catagits/Catalyst-Runtime.git] / lib / Catalyst.pm
index 9e41ec6..ccc6853 100644 (file)
@@ -67,7 +67,7 @@ our $GO        = Catalyst::Exception::Go->new;
 #I imagine that very few of these really need to be class variables. if any.
 #maybe we should just make them attributes with a default?
 __PACKAGE__->mk_classdata($_)
-  for qw/components arguments dispatcher engine log dispatcher_class
+  for qw/container components arguments dispatcher engine log dispatcher_class
   engine_class context_class request_class response_class stats_class
   setup_finished/;
 
@@ -548,9 +548,11 @@ sub _comp_names_search_prefixes {
     my $filter   = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
     $filter = qr/$filter/; # Compile regex now rather than once per loop
 
+    my @components = map { $c->container->get_sub_container($_)->get_service_list } qw(controller view model);
+
     # map the original component name to the sub part that we will search against
     my %eligible = map { my $n = $_; $n =~ s{^$appclass\::[^:]+::}{}; $_ => $n; }
-        grep { /$filter/ } keys %{ $c->components };
+        grep { /$filter/ } @components;
 
     # undef for a name will return all
     return keys %eligible if !defined $name;
@@ -653,9 +655,10 @@ sub controller {
     my $appclass = ref($c) || $c;
     if( $name ) {
         unless ( ref($name) ) { # Direct component hash lookup to avoid costly regexps
-            my $comps = $c->components;
             my $check = $appclass."::Controller::".$name;
-            return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
+            my $container = $c->container->get_sub_container('controller');
+            return $c->_filter_component( $container->resolve(service => "$check"), @args )
+                if $container->has_service($check);
         }
         my @result = $c->_comp_search_prefixes( $name, qw/Controller C/ );
         return map { $c->_filter_component( $_, @args ) } @result if ref $name;
@@ -691,9 +694,10 @@ sub model {
     my $appclass = ref($c) || $c;
     if( $name ) {
         unless ( ref($name) ) { # Direct component hash lookup to avoid costly regexps
-            my $comps = $c->components;
             my $check = $appclass."::Model::".$name;
-            return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
+            my $container = $c->container->get_sub_container('model');
+            return $c->_filter_component( $container->resolve(service => "$check"), @args )
+                if $container->has_service($check);
         }
         my @result = $c->_comp_search_prefixes( $name, qw/Model M/ );
         return map { $c->_filter_component( $_, @args ) } @result if ref $name;
@@ -750,10 +754,11 @@ sub view {
     my $appclass = ref($c) || $c;
     if( $name ) {
         unless ( ref($name) ) { # Direct component hash lookup to avoid costly regexps
-            my $comps = $c->components;
             my $check = $appclass."::View::".$name;
-            if( exists $comps->{$check} ) {
-                return $c->_filter_component( $comps->{$check}, @args );
+            my $container = $c->container->get_sub_container('view');
+            if ($container->has_service($check)) {
+
+                return $c->_filter_component( $container->resolve(service => $check), @args );
             }
             else {
                 $c->log->warn( "Attempted to use view '$check', but does not exist" );
@@ -794,7 +799,7 @@ Returns the available names which can be passed to $c->controller
 
 sub controllers {
     my ( $c ) = @_;
-    return $c->_comp_names(qw/Controller C/);
+    return $c->container->get_sub_container('controller')->get_service_list;
 }
 
 =head2 $c->models
@@ -805,7 +810,7 @@ Returns the available names which can be passed to $c->model
 
 sub models {
     my ( $c ) = @_;
-    return $c->_comp_names(qw/Model M/);
+    return $c->container->get_sub_container('model')->get_service_list;
 }
 
 
@@ -817,7 +822,7 @@ Returns the available names which can be passed to $c->view
 
 sub views {
     my ( $c ) = @_;
-    return $c->_comp_names(qw/View V/);
+    return $c->container->get_sub_container('view')->get_service_list;
 }
 
 =head2 $c->comp($name)
@@ -1112,6 +1117,7 @@ sub setup {
         }
     }
 
+    $class->setup_config();
     $class->setup_home( delete $flags->{home} );
 
     $class->setup_log( delete $flags->{log} );
@@ -1592,6 +1598,35 @@ These methods are not meant to be used by end users.
 
 Returns a hash of components.
 
+=cut
+
+around components => sub {
+    my $orig  = shift;
+    my $class = shift;
+    my $comps = shift;
+
+    return $class->$orig if ( !$comps );
+
+# FIXME: should this ugly kludge exist?
+    $class->setup_config unless defined $class->container;
+
+# FIXME: should there be a warning here, not to use this accessor to create the components?
+    my $components = {};
+
+    my $containers;
+    $containers->{$_} = $class->container->get_sub_container($_) for qw(model view controller);
+
+    for my $component ( keys %$comps ) {
+        $components->{ $component } = $comps->{$component};
+
+        my $type = _get_component_type($component);
+
+        $containers->{$type}->add_service(Bread::Board::BlockInjection->new( name => $component, block => sub { return $class->setup_component($component) } ));
+    }
+
+    return $class->$orig($components);
+};
+
 =head2 $c->context_class
 
 Returns or sets the context class.
@@ -2414,6 +2449,34 @@ Sets up actions for a component.
 
 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
 
+=head2 $c->setup_config
+
+=cut
+
+sub setup_config {
+    my $class = shift;
+
+    my %args = %{ $class->config || {} };
+
+    my @container_classes = ( "${class}::Container", 'Catalyst::Container');
+    unshift @container_classes, delete $args{container_class} if exists $args{container_class};
+
+    my $container_class = Class::MOP::load_first_existing_class(@container_classes);
+
+    my $container = $container_class->new( %args, name => "$class" );
+    $class->container($container);
+
+    my $config = $container->resolve(service => 'config');
+    $class->config($config);
+    $class->finalize_config; # back-compat
+}
+
+=head $c->finalize_config
+
+=cut
+
+sub finalize_config { }
+
 =head2 $c->setup_components
 
 This method is called internally to set up the application's components.
@@ -2451,18 +2514,45 @@ sub setup_components {
         Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
     }
 
+    my $containers;
+    $containers->{$_} = $class->container->get_sub_container($_) for qw(model view controller);
+
     for my $component (@comps) {
         my $instance = $class->components->{ $component } = $class->setup_component($component);
+        if ( my $type = _get_component_type($component) ) {
+            $containers->{$type}->add_service(Bread::Board::BlockInjection->new( name => $component, block => sub { return $instance } ));
+        }
         my @expanded_components = $instance->can('expand_modules')
             ? $instance->expand_modules( $component, $config )
             : $class->expand_component_module( $component, $config );
         for my $component (@expanded_components) {
             next if $comps{$component};
+
+            $deprecatedcatalyst_component_names = grep { /::[CMV]::/ } @expanded_components;
+            $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}
+            ) if $deprecatedcatalyst_component_names;
+
+            if (my $type = _get_component_type($component)) {
+                $containers->{$type}->add_service(Bread::Board::BlockInjection->new( name => $component, block => sub { return $class->setup_component($component) } ));
+            }
+
             $class->components->{ $component } = $class->setup_component($component);
         }
     }
 }
 
+sub _get_component_type {
+    my $component = shift;
+    my @parts     = split /::/, $component;
+
+    for (@parts) {
+        return 'controller' if /^c|controller$/i;
+        return 'model'      if /^m|model$/i;
+        return 'view'       if /^v|view$/i;
+    }
+}
+
 =head2 $c->locate_components( $setup_component_config )
 
 This method is meant to provide a list of component modules that should be
@@ -2533,8 +2623,7 @@ sub setup_component {
             message => qq/Couldn't instantiate component "$component", "$error"/
         );
     }
-
-    unless (blessed $instance) {
+    elsif (!blessed $instance) {
         my $metaclass = Moose::Util::find_meta($component);
         my $method_meta = $metaclass->find_method_by_name('COMPONENT');
         my $component_method_from = $method_meta->associated_metaclass->name;
@@ -2544,6 +2633,7 @@ sub setup_component {
             qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./
         );
     }
+
     return $instance;
 }