X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst.pm;h=7c51d8de924b3d75a26b985a4012c0f9c1aeb328;hb=5cd3e38f295b5e88b588f4a2dbd09cb5ccb2342f;hp=3427d7d77bd35380a8fc7c70e33cf3098c9ebbcd;hpb=61fd7cc3d8d53f025944e4945352af97c02594c7;p=catagits%2FCatalyst-Runtime.git

diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index 3427d7d..7c51d8d 100644
--- a/lib/Catalyst.pm
+++ b/lib/Catalyst.pm
@@ -15,9 +15,7 @@ use Catalyst::Response;
 use Catalyst::Utils;
 use Catalyst::Controller;
 use Data::OptList;
-use Devel::InnerPackage ();
 use File::stat;
-use Module::Pluggable::Object ();
 use Text::SimpleTable ();
 use Path::Class::Dir ();
 use Path::Class::File ();
@@ -27,7 +25,6 @@ use URI::https;
 use Tree::Simple qw/use_weak_refs/;
 use Tree::Simple::Visitor::FindByUID;
 use Class::C3::Adopt::NEXT;
-use Hash::Util qw/lock_hash/;
 use List::MoreUtils qw/uniq/;
 use attributes;
 use utf8;
@@ -80,7 +77,7 @@ __PACKAGE__->stats_class('Catalyst::Stats');
 
 # Remember to update this in Catalyst::Runtime as well!
 
-our $VERSION = '5.80032';
+our $VERSION = '5.80033';
 
 sub import {
     my ( $class, @arguments ) = @_;
@@ -567,13 +564,7 @@ If you want to search for controllers, pass in a regexp as the argument.
 
 =cut
 
-sub controller {
-    my ( $c, $name, @args ) = @_;
-
-    $name ||= Catalyst::Utils::class2classshortsuffix( $c->action->class );
-
-    return $c->container->get_component_from_sub_container( 'controller', $name, $c, @args);
-}
+sub controller { shift->_lookup_mvc('controller', @_) }
 
 =head2 $c->model($name)
 
@@ -596,20 +587,7 @@ If you want to search for models, pass in a regexp as the argument.
 
 =cut
 
-sub model {
-    my ( $c, $name, @args ) = @_;
-
-    if (ref $c && !$name) {
-        return $c->stash->{current_model_instance}
-            if $c->stash->{current_model_instance};
-
-        $name = $c->stash->{current_model}
-            if $c->stash->{current_model};
-    }
-
-    return $c->container->get_component_from_sub_container( 'model', $name, $c, @args);
-}
-
+sub model { shift->_lookup_mvc('model', @_) }
 
 =head2 $c->view($name)
 
@@ -632,18 +610,23 @@ If you want to search for views, pass in a regexp as the argument.
 
 =cut
 
-sub view {
-    my ( $c, $name, @args ) = @_;
+sub view { shift->_lookup_mvc('view', @_) }
+
+sub _lookup_mvc {
+    my ( $c, $type, $name, @args ) = @_;
 
     if (ref $c && !$name) {
-        return $c->stash->{current_view_instance}
-            if $c->stash->{current_view_instance};
+        my $current_instance = $c->stash->{"current_${type}_instance"};
+        return $current_instance
+            if $current_instance && $type ne 'controller';
 
-        $name = $c->stash->{current_view}
-            if $c->stash->{current_view};
+        $name = $type eq 'controller'
+              ? Catalyst::Utils::class2classshortsuffix($c->action->class)
+              : $c->stash->{"current_${type}"}
+              ;
     }
 
-    return $c->container->get_component_from_sub_container( 'view', $name, $c, @args);
+    return $c->container->get_component_from_sub_container($type, $name, $c, @args);
 }
 
 =head2 $c->controllers
@@ -704,19 +687,8 @@ sub component {
         return $c->component_list;
     }
 
-    my ($type, $name) = _get_component_type_name($component);
-
-    return $c->container->get_component_from_sub_container(
-        $type, $name, $c, @args
-    ) if $type;
-
     my @result = $c->container->find_component( $component, $c, @args );
 
-    # one last search for things like $c->comp(qr/::M::/)
-    @result = $c->container->find_component_regexp(
-        $c->components, $component, $c, @args
-    ) if !@result and ref $component;
-
     # list context for regexp searches
     return @result if ref $component;
 
@@ -1045,11 +1017,11 @@ EOF
 
     if (
         $class->debug and
-        my @comps_types = $class->container->get_components_types
+        my @comps_names_types = $class->container->get_components_names_types
     ) {
         my $column_width = Catalyst::Utils::term_width() - 8 - 9;
         my $t = Text::SimpleTable->new( [ $column_width, 'Class' ], [ 8, 'Type' ] );
-        $t->row( @$_ ) for @comps_types;
+        $t->row( @$_ ) for @comps_names_types;
 
         $class->log->debug( "Loaded components:\n" . $t->draw . "\n" );
     }
@@ -1454,39 +1426,16 @@ Returns a hash of components.
 sub components {
     my ( $class, $comps ) = @_;
 
-    # FIXME: should this ugly kludge exist?
-    $class->setup_config unless defined $class->container;
+    # people create components calling this sub directly, before setup
+    $class->setup_config unless $class->container;
 
-    my $containers;
-    $containers->{$_} = $class->container->get_sub_container($_)
-        for qw(model view controller);
+    my $container = $class->container;
 
     if ( $comps ) {
-        for my $component ( keys %$comps ) {
-            my ($type, $name) = _get_component_type_name($component);
-
-            $containers->{$type}->add_service(
-                Catalyst::IOC::BlockInjection->new(
-                    name  => $name,
-                    block => sub { $class->setup_component($component) },
-                )
-            );
-        }
-    }
-
-    my %components;
-    for my $container (keys %$containers) {
-        my @service_list = $containers->{$container}->get_service_list;
-        for my $component (@service_list) {
-            my $comp = $containers->{$container}->resolve(
-                service => $component
-            );
-            my $comp_name = ref $comp || $comp;
-            $components{$comp_name} = $comp;
-        }
+        $container->add_component( $_ ) for keys %$comps;
     }
 
-    return lock_hash %components;
+    return $container->get_all_components();
 }
 
 =head2 $c->context_class
@@ -2325,10 +2274,10 @@ sub setup_config {
 
     my $container_class = Class::MOP::load_first_existing_class(@container_classes);
 
-    my $container = $container_class->new( %args, name => "$class" );
+    my $container = $container_class->new( %args, application_name => "$class", name => "$class" );
     $class->container($container);
 
-    my $config = $container->resolve(service => 'config');
+    my $config = $container->resolve( service => 'config' );
     $class->config($config);
     $class->finalize_config; # back-compat
 }
@@ -2344,182 +2293,37 @@ sub finalize_config { }
 This method is called internally to set up the application's components.
 
 It finds modules by calling the L<locate_components> method, expands them to
-package names with the L<expand_component_module> method, and then installs
-each component into the application.
+package names with the $container->expand_component_module method, and then
+installs each component into the application.
 
 The C<setup_components> config option is passed to both of the above methods.
 
-Installation of each component is performed by the L<setup_component> method,
-below.
-
 =cut
 
 sub setup_components {
-    my $class = shift;
-
-    my $config  = $class->config->{ setup_components };
-
-    Catalyst::Exception->throw(
-        qq{You are using search_extra config option. That option is\n} .
-        qq{deprecated, please refer to the documentation for\n} .
-        qq{other ways of achieving the same results.\n}
-    ) if delete $config->{ search_extra };
-
-    my @comps = $class->locate_components($config);
-    my %comps = map { $_ => 1 } @comps;
-
-    my $deprecatedcatalyst_component_names = grep { /::[CMV]::/ } @comps;
-    $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;
-
-    for my $component ( @comps ) {
-
-        # We pass ignore_loaded here so that overlay files for (e.g.)
-        # Model::DBI::Schema sub-classes are loaded - if it's in @comps
-        # we know M::P::O found a file on disk so this is safe
-
-        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->setup_component($component);
-        if ( my ($type, $name) = _get_component_type_name($component) ) {
-            $containers->{$type}->add_service(Catalyst::IOC::BlockInjection->new( name => $name, 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, $name) = _get_component_type_name($component)) {
-                $containers->{$type}->add_service(Catalyst::IOC::BlockInjection->new( name => $name, block => sub { return $class->setup_component($component) } ));
-            }
-        }
-    }
-
-    $containers->{model}->make_single_default;
-    $containers->{view}->make_single_default;
-}
-
-# FIXME: should this sub exist?
-# should it be moved to Catalyst::Utils,
-# or replaced by something already existing there?
-sub _get_component_type_name {
-    my ( $component ) = @_;
-
-    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;
-    }
-
-    return (undef, $component);
+    shift->container->setup_components();
 }
 
-sub _get_component_type {
-    my ( $instance ) = @_;
-
-    return 'controller' if $instance->isa('Catalyst::Controller');
-    return 'model'      if $instance->isa('Catalyst::Model');
-    return 'view'       if $instance->isa('Catalyst::View');
-}
-
-=head2 $c->locate_components( $setup_component_config )
-
-This method is meant to provide a list of component modules that should be
-setup for the application.  By default, it will use L<Module::Pluggable>.
-
-Specify a C<setup_components> config option to pass additional options directly
-to L<Module::Pluggable>.
+=head2 locate_components
 
 =cut
 
-sub locate_components {
-    my $class  = shift;
-    my $config = shift;
+# FIXME - removed locate_components
+# don't people mess with this method directly?
+# what to do with that?
 
-    my @paths   = qw( ::Controller ::C ::Model ::M ::View ::V );
+sub locate_components {
+    my $class = shift;
 
-    my $locator = Module::Pluggable::Object->new(
-        search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
-        %$config
-    );
+    $class->log->warn('The locate_components method has been deprecated.');
+    $class->log->warn('Please read Catalyst::IOC::Container documentation to');
+    $class->log->warn('update your application.');
 
     # XXX think about ditching this sort entirely
-    my @comps = sort { length $a <=> length $b } $locator->plugins;
-
-    return @comps;
-}
-
-=head2 $c->expand_component_module( $component, $setup_component_config )
-
-Components found by C<locate_components> will be passed to this method, which
-is expected to return a list of component (package) names to be set up.
-
-=cut
-
-sub expand_component_module {
-    my ($class, $module) = @_;
-    return Devel::InnerPackage::list_packages( $module );
+    return sort { length $a <=> length $b }
+        @{ $class->container->resolve( service => 'locate_components' ) };
 }
 
-=head2 $c->setup_component
-
-=cut
-
-## FIXME - Why the hell do we try calling the ->COMPONENT method twice, this is madness!?!
-sub setup_component {
-    my( $class, $component ) = @_;
-
-    unless ( $component->can( 'COMPONENT' ) ) {
-        return $component;
-    }
-
-    my $suffix = Catalyst::Utils::class2classsuffix( $component );
-    my $config = $class->config->{ $suffix } || {};
-    # Stash catalyst_component_name in the config here, so that custom COMPONENT
-    # methods also pass it. local to avoid pointlessly shitting in config
-    # for the debug screen, as $component is already the key name.
-    local $config->{catalyst_component_name} = $component;
-
-    my $instance = eval { $component->COMPONENT( $class, $config ); };
-
-    if ( my $error = $@ ) {
-        chomp $error;
-        Catalyst::Exception->throw(
-            message => qq/Couldn't instantiate component "$component", "$error"/
-        );
-    }
-    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;
-        my $value = defined($instance) ? $instance : 'undef';
-        Catalyst::Exception->throw(
-            message =>
-            qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./
-        );
-    }
-
-    return $instance;
-}
 
 =head2 $c->setup_dispatcher