Merge branch 'master' into gsoc_breadboard
André Walker [Tue, 5 Jul 2011 14:48:38 +0000 (11:48 -0300)]
1  2 
lib/Catalyst.pm

diff --combined lib/Catalyst.pm
@@@ -67,7 -67,7 +67,7 @@@ our $GO        = Catalyst::Exception::G
  #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,11 -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;
@@@ -655,10 -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;
@@@ -694,10 -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;
@@@ -754,11 -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" );
@@@ -799,7 -794,7 +799,7 @@@ Returns the available names which can b
  
  sub controllers {
      my ( $c ) = @_;
 -    return $c->_comp_names(qw/Controller C/);
 +    return $c->container->get_sub_container('controller')->get_service_list;
  }
  
  =head2 $c->models
@@@ -810,7 -805,7 +810,7 @@@ Returns the available names which can b
  
  sub models {
      my ( $c ) = @_;
 -    return $c->_comp_names(qw/Model M/);
 +    return $c->container->get_sub_container('model')->get_service_list;
  }
  
  
@@@ -822,7 -817,7 +822,7 @@@ Returns the available names which can b
  
  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)
@@@ -866,6 -861,9 +866,9 @@@ sub component 
              return $c->_filter_component( $comp, @args ) if $comp;
          }
  
+         return
+             if $c->config->{disable_component_resolution_regex_fallback};
          # This is here so $c->comp( '::M::' ) works
          my $query = ref $name ? $name : qr{$name}i;
  
@@@ -1114,7 -1112,6 +1117,7 @@@ sub setup 
          }
      }
  
 +    $class->setup_config();
      $class->setup_home( delete $flags->{home} );
  
      $class->setup_log( delete $flags->{log} );
@@@ -1595,35 -1592,6 +1598,35 @@@ These methods are not meant to be used 
  
  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.
@@@ -2446,34 -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.
@@@ -2511,45 -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
@@@ -2620,7 -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;
              qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./
          );
      }
 +
      return $instance;
  }
  
@@@ -2894,7 -2807,7 +2897,7 @@@ the plugin name does not begin with C<C
          my $class = ref $proto || $proto;
  
          Class::MOP::load_class( $plugin );
-         $class->log->warn( "$plugin inherits from 'Catalyst::Component' - this is decated and will not work in 5.81" )
+         $class->log->warn( "$plugin inherits from 'Catalyst::Component' - this is deprecated and will not work in 5.81" )
              if $plugin->isa( 'Catalyst::Component' );
          $proto->_plugins->{$plugin} = 1;
          unless ($instant) {