From: André Walker Date: Fri, 19 Aug 2011 21:37:35 +0000 (-0300) Subject: merge master X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=b8c160a4a02cba800468b8bba63e244da662b694;hp=-c merge master --- b8c160a4a02cba800468b8bba63e244da662b694 diff --combined .gitignore index 19a3918,cf496fb..6b5b6de --- a/.gitignore +++ b/.gitignore @@@ -2,6 -2,7 +2,7 @@@ !.gitignore Makefile* !Makefile.PL + MYMETA.json MYMETA.yml META.yml blib @@@ -15,4 -16,3 +16,4 @@@ Debian Catalyst-Runtime-* *.bs t/tmp +cover_db/ diff --combined Makefile.PL index c00267d,a2d9499..912cd95 --- a/Makefile.PL +++ b/Makefile.PL @@@ -13,16 -13,17 +13,18 @@@ perl_version '5.008004' name 'Catalyst-Runtime'; all_from 'lib/Catalyst/Runtime.pm'; +requires 'Bread::Board'; requires 'List::MoreUtils'; requires 'namespace::autoclean' => '0.09'; requires 'namespace::clean' => '0.13'; requires 'B::Hooks::EndOfScope' => '0.08'; requires 'MooseX::Emulate::Class::Accessor::Fast' => '0.00903'; requires 'Class::MOP' => '0.95'; + requires 'Data::OptList'; requires 'Moose' => '1.03'; requires 'MooseX::MethodAttributes::Inheritable' => '0.24'; requires 'MooseX::Role::WithOverloading' => '0.09'; + requires 'MooseX::Types::LoadableClass' => '0.003'; requires 'Carp'; requires 'Class::C3::Adopt::NEXT' => '0.07'; requires 'CGI::Simple::Cookie' => '1.109'; @@@ -44,6 -45,7 +46,7 @@@ requires 'Text::SimpleTable' => '0.03' requires 'Time::HiRes'; requires 'Tree::Simple' => '1.15'; requires 'Tree::Simple::Visitor::FindByPath'; + requires 'Try::Tiny'; requires 'URI' => '1.35'; requires 'Task::Weaken'; requires 'Text::Balanced'; # core in 5.8.x but mentioned for completeness @@@ -51,12 -53,16 +54,17 @@@ requires 'MRO::Compat' requires 'MooseX::Getopt' => '0.30'; requires 'MooseX::Types'; requires 'MooseX::Types::Common::Numeric'; +requires 'MooseX::Types::LoadableClass'; requires 'String::RewritePrefix' => '0.004'; # Catalyst::Utils::resolve_namespace + requires 'Plack' => '0.9974'; # IIS6 fix middleware + requires 'Plack::Middleware::ReverseProxy' => '0.04'; + requires 'Plack::Test::ExternalServer'; test_requires 'Class::Data::Inheritable'; test_requires 'Test::Exception'; test_requires 'Test::More' => '0.88'; + test_requires 'Data::Dump'; + test_requires 'HTTP::Request::Common'; # aggregate tests if AGGREGATE_TESTS is set and a recent Test::Aggregate and a Test::Simple it works with is available if ($ENV{AGGREGATE_TESTS} && can_use('Test::Simple', '0.88') && can_use('Test::Aggregate', '0.364')) { @@@ -72,13 -78,17 +80,17 @@@ else author_requires 'CatalystX::LeakChecker', '0.05'; author_requires 'File::Copy::Recursive'; # For http server test author_requires 'Catalyst::Devel', '1.0'; # For http server test + author_requires 'Catalyst::Engine::PSGI'; + author_requires 'Test::Without::Module'; + author_requires 'Starman'; + author_requires 'MooseX::Daemonize'; author_tests 't/author'; author_requires(map {; $_ => 0 } qw( Test::NoTabs Test::Pod Test::Pod::Coverage - Pod::Coverage + Pod::Coverage::TrustPod )); if ($Module::Install::AUTHOR) { @@@ -127,27 -137,32 +139,32 @@@ my %conflicts = 'Catalyst::Plugin::Unicode::Encoding' => '0.2', 'Catalyst::Plugin::Authentication' => '0.10010', # _config accessor in ::Credential::Password 'Catalyst::Authentication::Credential::HTTP' => '1.009', - 'Catalyst::Plugin::Session::Store::File' => '0.16', - 'Catalyst::Plugin::Session' => '0.21', - 'Catalyst::Plugin::Session::State::Cookie' => '0.10', + 'Catalyst::Plugin::Session::Store::File' => '0.16', + 'Catalyst::Plugin::Session' => '0.21', + 'Catalyst::Plugin::Session::State::Cookie' => '0.10', 'Catalyst::Plugin::Session::Store::FastMmap' => '0.09', - 'Catalyst::Controller::AllowDisable' => '0.03', - 'Reaction' => '0.001999', - 'Catalyst::Plugin::Upload::Image::Magick' => '0.03', - 'Catalyst::Plugin::ConfigLoader' => '0.22', # Older versions work but + 'Catalyst::Controller::AllowDisable' => '0.03', + 'Reaction' => '0.001999', + 'Catalyst::Plugin::Upload::Image::Magick' => '0.03', + 'Catalyst::Plugin::ConfigLoader' => '0.22', # Older versions work but # throw Data::Visitor warns - 'Catalyst::Devel' => '1.19', - 'Catalyst::Plugin::SmartURI' => '0.032', - 'CatalystX::CRUD' => '0.37', - 'Catalyst::Action::RenderView' => '0.07', - 'Catalyst::Plugin::DebugCookie' => '0.999002', - 'Catalyst::Plugin::Authentication' => '0.100091', - 'CatalystX::Imports' => '0.03', - 'Catalyst::Plugin::HashedCookies' => '1.03', - 'Catalyst::Action::REST' => '0.67', - 'CatalystX::CRUD' => '0.42', - 'CatalystX::CRUD::Model::RDBO' => '0.20', - 'Catalyst::View::Mason' => '0.17', + 'Catalyst::Devel' => '1.19', + 'Catalyst::Plugin::SmartURI' => '0.032', + 'CatalystX::CRUD' => '0.37', + 'Catalyst::Action::RenderView' => '0.07', + 'Catalyst::Plugin::DebugCookie' => '0.999002', + 'Catalyst::Plugin::Authentication' => '0.100091', + 'CatalystX::Imports' => '0.03', + 'Catalyst::Plugin::HashedCookies' => '1.03', + 'Catalyst::Action::REST' => '0.67', + 'CatalystX::CRUD' => '0.42', + 'CatalystX::CRUD::Model::RDBO' => '0.20', + 'Catalyst::View::Mason' => '0.17', + # Note these are not actually needed - they fail tests against the + # new version, but still work fine.. + # 'Catalyst::ActionRole::ACL' => '0.05', + # 'Catalyst::Plugin::Session::Store::DBIC' => '0.11', + 'Test::WWW::Mechanize::Catalyst' => '0.53', # Dep warnings unless upgraded. ); check_conflicts(%conflicts); diff --combined TODO index ba8e48f,81bda4b..94d2bad --- a/TODO +++ b/TODO @@@ -24,14 -24,40 +24,40 @@@ subclass of Catalyst::Log, no ::Plugin: See also: Catalyst::Plugin::Log::Dispatch and http://github.com/willert/catalyst-plugin-log4perl-simple/tree - # REFACTORING + ## Capture arguments that the plack engine component was run with somewhere, + to more easily support custom args from scripts (e.g. Gitalist's + --git_dir) - ## The horrible hack for plugin setup - replacing it: + ## throw away the restarter and allow using the restarters Plack provides + + ## remove per-request state from the engine instance + + ## be smarter about how we use PSGI - not every response needs to be delayed + and streaming + + # The horrible hack for plugin setup - replacing it: * Have a look at the Devel::REPL BEFORE_PLUGIN stuff I wonder if what we need is that combined with plugins-as-roles - ## App / ctx split: + # PSGI + + ## To do at release time + + - Release psgi branch of Catalyst-Devel + - Release new Task::Catalyst + - Release 5.9 branch of Catalyst-Manual + - Release Catalyst::Engine::HTTP::Prefork with deprecation notice + + exit in Makefile.PL if Catalyst > 5.89 is installed. + + ## Blockers + + * I've noticed a small difference with Catalyst::Test. The latest stable + version include two headers, 'host' and 'https'. They are missing from + this version - Pedro Melo on list + ^^ Cannot replicate this? Mailed back to ask for tests.. + + # App / ctx split: NOTE - these are notes that t0m thought up after doing back compat for catalyst_component_class, may be inaccurate, wrong or missing things @@@ -54,120 -80,3 +80,120 @@@ - Profit! (Things like changing the complete app config per vhost, i.e. writing a config loader / app class role which dispatches per vhost to differently configured apps is piss easy) + +## GSOC + +### Final steps for GSOC + +##### Things that work: + + - the default container loads all components, calls ACCEPT_CONTEXT() when appropriate, and COMPONENT() when appropriate, behaving like current Catalyst does + + - its possible to create a custom container, and override the components you want. Lifecycle, class, dependencies, all overridable. + + - config files are loaded without Catalyst::Plugin::ConfigLoader + + - per request life cycle somewhat works + + - external modules are loaded just using a custom container, much like Catalyst::Model::Adaptor + +##### Things that don't work: + + - expand_component_module + + - sugar is still not completely implemented + + - Some back compat + - wrappers around setup_component, setup_components, locate_components in Catalyst.pm + - $instance->expand_modules + - search_extra + - Crazy tests for things such as: + sub COMPONENT { + ... + *${appclass}::Model::TopLevel::GENERATED::ACCEPT_CONTEXT = sub { ... }; + ... + } + +##### Need planning, have questions: + + - per request life cycle + + - sugar - we should discuss the syntax with rafl and edenc + + - when / when not COMPONENT should be called + + - locate_components service vs setup_components method + - can we be more lazy? + - should setup_components be a service that things like the ->component lookup + can depend on? + + - There are a few more FIXMEs, idk if any relevant here + +### Next steps - planned: + + - some imports need to get the importing package in Catalyst::IOC + - done - needs testing + + - Back compat for Catalyst.pm moved methods (locate_components) + - done - needs testing + + - Test custom container + - writing some tests which verify that the models you think should be + there are there, and that they received their dependencies as arguments + - i.e. Model::Bar should get params { foo => $model_foo } when being + constructed, etc + - Need to test that if you have a standard component Frotz + and a customized component Fnar, and Fnar depends on Frotz + - And yeah, some tests that the customised components actually work via + $c->model('Foo'), and that COMPONENT is called (or not called) + as appropiate and that ACCEPT_CONTEXT is called (or not) as appropriate + +### Next steps - less planned: + + - make ACCEPT_CONTEXT and COMPONENT optional in Catalyst::IOC::BlockInjection and Catalyst::IOC::ConstructorInjection + - Create COMPONENTSingleton life cycle + + - Creating service()-like sugar for component + + - Test cases for extending the container in an application. + - Using the sugar added in the previous item + - Test when Model::Foo depends_on Model::Bar + - Test for component Foo => ( lifecycle => 'Singleton', class => 'My::External::Class', dependencies => { config => depends_on("config") } ) + - Fix ^^ so that you can get your component's namespaced config nicely. + + - Tests for using the container outside of Catalyst + - Custom container which adds some (very simple) services which are initialized from + the application config file (note plain services, not components) + - Depend on (and test) these inside Catalyst + - Test loading container outside Catalyst, and these services working + - Test Catalyst / MyApp is not loaded + +#### Extending my app, notes + +Basically try to implement something like this (starting out without the sugar!), and see how it breaks +and what needs to be done to fix it! + +##### Eventual syntax + +package MyApp::Container; +use Catalyst::IOC; + + container $self, as { + container model => as { + component Foo => (); # As per default! + component Bar => (dependencies => ['/model/Foo']); # Magic! + component Baz => ( lifecycle => 'InstancePerContext ); + component Quux => ( lifecycle => 'Singleton' ); # ACCEPT_CONTEXT not called + # Catalyst::Model::Adaptor example + conponent Fnar => ( lifecycle => 'Singleton', class => 'My::External::Class', dependencies => { config => depends_on('config')} ); + # ^^ FIXME - gets whole config, not Model::Foo + # There should be a 'nice' way to get the 'standard' config + }; + # Note - implementation of BB may need to be changed to support making sure existing + # services actually get overridden. not sure how the default container behaves when doing that + # above code would build the constructor injection as it currently does, + # defaulting to the class name in the right namespace as declared by the surrounding container + # as well as adding using the catalyst-specific service class + }; + +1; diff --combined lib/Catalyst.pm index a727189,6621825..79bdf3d --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@@ -15,7 -15,8 +15,7 @@@ use Catalyst::Response use Catalyst::Utils; use Catalyst::Controller; use Data::OptList; -use Devel::InnerPackage (); -use Module::Pluggable::Object (); +use File::stat; use Text::SimpleTable (); use Path::Class::Dir (); use Path::Class::File (); @@@ -27,8 -28,15 +27,15 @@@ use Tree::Simple::Visitor::FindByUID use Class::C3::Adopt::NEXT; use List::MoreUtils qw/uniq/; use attributes; + use String::RewritePrefix; + use Catalyst::EngineLoader; use utf8; use Carp qw/croak carp shortmess/; + use Try::Tiny; + use Plack::Middleware::Conditional; + use Plack::Middleware::ReverseProxy; + use Plack::Middleware::IIS6ScriptNameFix; + use Plack::Middleware::LighttpdScriptNameFix; BEGIN { require 5.008004; } @@@ -65,19 -73,18 +72,24 @@@ 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($_) ++<<<<<<< HEAD + for qw/container arguments dispatcher engine log dispatcher_class + engine_class context_class request_class response_class stats_class + setup_finished/; ++======= + for qw/components arguments dispatcher engine log dispatcher_class + engine_loader context_class request_class response_class stats_class + setup_finished _psgi_app loading_psgi_file/; ++>>>>>>> master __PACKAGE__->dispatcher_class('Catalyst::Dispatcher'); - __PACKAGE__->engine_class('Catalyst::Engine::CGI'); __PACKAGE__->request_class('Catalyst::Request'); __PACKAGE__->response_class('Catalyst::Response'); __PACKAGE__->stats_class('Catalyst::Stats'); # Remember to update this in Catalyst::Runtime as well! - our $VERSION = '5.80033'; + our $VERSION = '5.90001'; sub import { my ( $class, @arguments ) = @_; @@@ -90,12 -97,10 +102,12 @@@ return if $caller eq 'main'; my $meta = Moose::Meta::Class->initialize($caller); - unless ( $caller->isa('Catalyst') ) { - my @superclasses = ($meta->superclasses, $class, 'Catalyst::Controller'); - $meta->superclasses(@superclasses); - } + + unless ( $caller->isa('Catalyst') ) { # XXX - Remove! + my @superclasses = ($meta->superclasses, $class, 'Catalyst::Component'); # XXX - Remove! + $meta->superclasses(@superclasses); # XXX - Remove! + } # XXX - Remove! + # Avoid possible C3 issues if 'Moose::Object' is already on RHS of MyApp $meta->superclasses(grep { $_ ne 'Moose::Object' } $meta->superclasses); @@@ -112,15 -117,6 +124,15 @@@ $caller->setup_home; } +sub MODIFY_CODE_ATTRIBUTES { + Catalyst::Exception->throw( + "Catalyst applications (aka MyApp) cannot be controllers anymore. " . + "That has been deprecated and removed. You should create a " . + "controller class called Root.pm, and move relevant code to that class." + ); +} + + sub _application { $_[0] } =head1 NAME @@@ -545,6 -541,98 +557,6 @@@ sub clear_errors $c->error(0); } -sub _comp_search_prefixes { - my $c = shift; - return map $c->components->{ $_ }, $c->_comp_names_search_prefixes(@_); -} - -# search components given a name and some prefixes -sub _comp_names_search_prefixes { - my ( $c, $name, @prefixes ) = @_; - my $appclass = ref $c || $c; - my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::'; - $filter = qr/$filter/; # Compile regex now rather than once per loop - - # 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 }; - - # undef for a name will return all - return keys %eligible if !defined $name; - - my $query = ref $name ? $name : qr/^$name$/i; - my @result = grep { $eligible{$_} =~ m{$query} } keys %eligible; - - return @result if @result; - - # if we were given a regexp to search against, we're done. - return if ref $name; - - # skip regexp fallback if configured - return - if $appclass->config->{disable_component_resolution_regex_fallback}; - - # regexp fallback - $query = qr/$name/i; - @result = grep { $eligible{ $_ } =~ m{$query} } keys %eligible; - - # no results? try against full names - if( !@result ) { - @result = grep { m{$query} } keys %eligible; - } - - # don't warn if we didn't find any results, it just might not exist - if( @result ) { - # Disgusting hack to work out correct method name - my $warn_for = lc $prefixes[0]; - my $msg = "Used regexp fallback for \$c->${warn_for}('${name}'), which found '" . - (join '", "', @result) . "'. Relying on regexp fallback behavior for " . - "component resolution is unreliable and unsafe."; - my $short = $result[0]; - # remove the component namespace prefix - $short =~ s/.*?(Model|Controller|View):://; - my $shortmess = Carp::shortmess(''); - if ($shortmess =~ m#Catalyst/Plugin#) { - $msg .= " You probably need to set '$short' instead of '${name}' in this " . - "plugin's config"; - } elsif ($shortmess =~ m#Catalyst/lib/(View|Controller)#) { - $msg .= " You probably need to set '$short' instead of '${name}' in this " . - "component's config"; - } else { - $msg .= " You probably meant \$c->${warn_for}('$short') instead of \$c->${warn_for}('${name}'), " . - "but if you really wanted to search, pass in a regexp as the argument " . - "like so: \$c->${warn_for}(qr/${name}/)"; - } - $c->log->warn( "${msg}$shortmess" ); - } - - return @result; -} - -# Find possible names for a prefix -sub _comp_names { - my ( $c, @prefixes ) = @_; - my $appclass = ref $c || $c; - - my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::'; - - my @names = map { s{$filter}{}; $_; } - $c->_comp_names_search_prefixes( undef, @prefixes ); - - return @names; -} - -# Filter a component before returning by calling ACCEPT_CONTEXT if available -sub _filter_component { - my ( $c, $comp, @args ) = @_; - - if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) { - return $comp->ACCEPT_CONTEXT( $c, @args ); - } - - return $comp; -} - =head2 COMPONENT ACCESSORS =head2 $c->controller($name) @@@ -564,7 -652,23 +576,7 @@@ If you want to search for controllers, =cut -sub controller { - my ( $c, $name, @args ) = @_; - - 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 @result = $c->_comp_search_prefixes( $name, qw/Controller C/ ); - return map { $c->_filter_component( $_, @args ) } @result if ref $name; - return $c->_filter_component( $result[ 0 ], @args ); - } - - return $c->component( $c->action->class ); -} +sub controller { shift->_lookup_mvc('controller', @_) } =head2 $c->model($name) @@@ -587,7 -691,42 +599,7 @@@ If you want to search for models, pass =cut -sub model { - my ( $c, $name, @args ) = @_; - 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 @result = $c->_comp_search_prefixes( $name, qw/Model M/ ); - return map { $c->_filter_component( $_, @args ) } @result if ref $name; - return $c->_filter_component( $result[ 0 ], @args ); - } - - if (ref $c) { - return $c->stash->{current_model_instance} - if $c->stash->{current_model_instance}; - return $c->model( $c->stash->{current_model} ) - if $c->stash->{current_model}; - } - return $c->model( $appclass->config->{default_model} ) - if $appclass->config->{default_model}; - - my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/Model M/); - - if( $rest ) { - $c->log->warn( Carp::shortmess('Calling $c->model() will return a random model unless you specify one of:') ); - $c->log->warn( '* $c->config(default_model => "the name of the default model to use")' ); - $c->log->warn( '* $c->stash->{current_model} # the name of the model to use for this request' ); - $c->log->warn( '* $c->stash->{current_model_instance} # the instance of the model to use for this request' ); - $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' ); - } - - return $c->_filter_component( $comp ); -} - +sub model { shift->_lookup_mvc('model', @_) } =head2 $c->view($name) @@@ -610,23 -749,46 +622,23 @@@ If you want to search for views, pass i =cut -sub view { - my ( $c, $name, @args ) = @_; +sub view { shift->_lookup_mvc('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 ); - } - else { - $c->log->warn( "Attempted to use view '$check', but does not exist" ); - } - } - my @result = $c->_comp_search_prefixes( $name, qw/View V/ ); - return map { $c->_filter_component( $_, @args ) } @result if ref $name; - return $c->_filter_component( $result[ 0 ], @args ); - } - - if (ref $c) { - return $c->stash->{current_view_instance} - if $c->stash->{current_view_instance}; - return $c->view( $c->stash->{current_view} ) - if $c->stash->{current_view}; - } - return $c->view( $appclass->config->{default_view} ) - if $appclass->config->{default_view}; +sub _lookup_mvc { + my ( $c, $type, $name, @args ) = @_; - my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/View V/); + if (ref $c && !$name) { + my $current_instance = $c->stash->{"current_${type}_instance"}; + return $current_instance + if $current_instance && $type ne 'controller'; - if( $rest ) { - $c->log->warn( 'Calling $c->view() will return a random view unless you specify one of:' ); - $c->log->warn( '* $c->config(default_view => "the name of the default view to use")' ); - $c->log->warn( '* $c->stash->{current_view} # the name of the view to use for this request' ); - $c->log->warn( '* $c->stash->{current_view_instance} # the instance of the view to use for this request' ); - $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' ); + $name = $type eq 'controller' + ? Catalyst::Utils::class2classshortsuffix($c->action->class) + : $c->stash->{"current_${type}"} + ; } - return $c->_filter_component( $comp ); + return $c->container->get_component_from_sub_container($type, $name, $c, @args); } =head2 $c->controllers @@@ -637,7 -799,7 +649,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 @@@ -648,7 -810,7 +660,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; } @@@ -660,7 -822,7 +672,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) @@@ -675,50 -837,57 +687,50 @@@ should be used instead If C<$name> is a regexp, a list of components matched against the full component name will be returned. =cut sub component { - my ( $c, $name, @args ) = @_; + my ( $c, $component, @args ) = @_; - if( $name ) { - my $comps = $c->components; + unless ($component) { + $c->log->warn('Calling $c->component with no args is deprecated and '); + $c->log->warn('will be removed in a future release.'); + $c->log->warn('Use $c->component_list instead.'); + return $c->component_list; + } - if( !ref $name ) { - # is it the exact name? - return $c->_filter_component( $comps->{ $name }, @args ) - if exists $comps->{ $name }; + my @result = $c->container->find_component( $component, $c, @args ); - # perhaps we just omitted "MyApp"? - my $composed = ( ref $c || $c ) . "::${name}"; - return $c->_filter_component( $comps->{ $composed }, @args ) - if exists $comps->{ $composed }; + # list context for regexp searches + return @result if ref $component; - # search all of the models, views and controllers - my( $comp ) = $c->_comp_search_prefixes( $name, qw/Model M Controller C View V/ ); - return $c->_filter_component( $comp, @args ) if $comp; - } + # only one component (if it's found) for string searches + return shift @result if @result; - return - if $c->config->{disable_component_resolution_regex_fallback}; + if (ref $c eq $component) { + $c->log->warn('You are calling $c->comp("MyApp"). This behaviour is'); + $c->log->warn('deprecated, and will be removed in a future release.'); + return $c; + } - # This is here so $c->comp( '::M::' ) works - my $query = ref $name ? $name : qr{$name}i; + $c->log->warn("Looking for '$component', but nothing was found."); - my @result = grep { m{$query} } keys %{ $c->components }; - return map { $c->_filter_component( $_, @args ) } @result if ref $name; + # I would expect to return an empty list here, but that breaks back-compat + $c->log->warn('Component not found, returning the list of existing'); + $c->log->warn('components. This behavior is deprecated and will be'); + $c->log->warn('removed in a future release. Use $c->component_list'); + $c->log->warn('instead.'); - if( $result[ 0 ] ) { - $c->log->warn( Carp::shortmess(qq(Found results for "${name}" using regexp fallback)) ); - $c->log->warn( 'Relying on the regexp fallback behavior for component resolution' ); - $c->log->warn( 'is unreliable and unsafe. You have been warned' ); - return $c->_filter_component( $result[ 0 ], @args ); - } + return $c->component_list; +} - # I would expect to return an empty list here, but that breaks back-compat - } +=head2 $c->component_list - # fallback - return sort keys %{ $c->components }; -} +Returns the sorted list of the component names of the application. + +=cut + +sub component_list { sort keys %{ shift->components } } =head2 CLASS DATA AND HELPER CLASSES @@@ -884,7 -1053,7 +896,7 @@@ Please do not use this functionality i sub plugin { my ( $class, $name, $plugin, @args ) = @_; - # See block comment in t/unit_core_plugin.t + # See block comment in t/aggregate/unit_core_plugin.t $class->log->warn(qq/Adding plugin using the ->plugin method is deprecated, and will be removed in Catalyst 5.81/); $class->_register_plugin( $plugin, 1 ); @@@ -948,13 -1117,15 +960,16 @@@ sub setup } } + $class->setup_config(); $class->setup_home( delete $flags->{home} ); $class->setup_log( delete $flags->{log} ); $class->setup_plugins( delete $flags->{plugins} ); $class->setup_dispatcher( delete $flags->{dispatcher} ); - $class->setup_engine( delete $flags->{engine} ); + if (my $engine = delete $flags->{engine}) { + $class->log->warn("Specifying the engine in ->setup is no longer supported, see Catalyst::Upgrading"); + } + $class->setup_engine(); $class->setup_stats( delete $flags->{stats} ); for my $flag ( sort keys %{$flags} ) { @@@ -1013,17 -1184,25 +1028,17 @@@ EO $class->setup unless $Catalyst::__AM_RESTARTING; } - # Initialize our data structure - $class->components( {} ); - $class->setup_components; - if ( $class->debug ) { + if ( + $class->debug and + my $comps = $class->container->get_all_components($class) + ) { my $column_width = Catalyst::Utils::term_width() - 8 - 9; my $t = Text::SimpleTable->new( [ $column_width, 'Class' ], [ 8, 'Type' ] ); - for my $comp ( sort keys %{ $class->components } ) { - my $type = ref $class->components->{$comp} ? 'instance' : 'class'; - $t->row( $comp, $type ); - } - $class->log->debug( "Loaded components:\n" . $t->draw . "\n" ) - if ( keys %{ $class->components } ); - } + $t->row( $_ => ref($comps->{$_}) ? 'instance' : 'class' ) for keys %$comps; - # Add our self to components, since we are also a component - if( $class->isa('Catalyst::Controller') ){ - $class->components->{$class} = $class; + $class->log->debug( "Loaded components:\n" . $t->draw . "\n" ); } $class->setup_actions; @@@ -1421,23 -1600,6 +1436,23 @@@ These methods are not meant to be used Returns a hash of components. +=cut + +sub components { + my ( $class, $comps ) = @_; + + # people create components calling this sub directly, before setup + $class->setup_config unless $class->container; + + my $container = $class->container; + + if ( $comps ) { + $container->add_component( $_ ) for keys %$comps; + } + + return $container->get_all_components($class); +} + =head2 $c->context_class Returns or sets the context class. @@@ -1713,9 -1875,9 +1728,9 @@@ sub finalize_headers # get the length from a filehandle if ( blessed( $response->body ) && $response->body->can('read') || ref( $response->body ) eq 'GLOB' ) { - my $stat = stat $response->body; - if ( $stat && $stat->size > 0 ) { - $response->content_length( $stat->size ); + my $size = -s $response->body; + if ( $size ) { + $response->content_length( $size ); } else { $c->log->warn('Serving filehandle without a content-length'); @@@ -1789,7 -1951,7 +1804,7 @@@ sub handle_request # Always expect worst case! my $status = -1; - eval { + try { if ($class->debug) { my $secs = time - $START || 1; my $av = sprintf '%.3f', $COUNT / $secs; @@@ -1800,12 -1962,11 +1815,11 @@@ my $c = $class->prepare(@arguments); $c->dispatch; $status = $c->finalize; - }; - - if ( my $error = $@ ) { - chomp $error; - $class->log->error(qq/Caught exception in engine "$error"/); } + catch { + chomp(my $error = $_); + $class->log->error(qq/Caught exception in engine "$error"/); + }; $COUNT++; @@@ -1842,28 -2003,38 +1856,38 @@@ sub prepare $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION ); } - #XXX reuse coderef from can - # Allow engine to direct the prepare flow (for POE) - if ( $c->engine->can('prepare') ) { - $c->engine->prepare( $c, @arguments ); - } - else { - $c->prepare_request(@arguments); - $c->prepare_connection; - $c->prepare_query_parameters; - $c->prepare_headers; - $c->prepare_cookies; - $c->prepare_path; - - # Prepare the body for reading, either by prepare_body - # or the user, if they are using $c->read - $c->prepare_read; - - # Parse the body unless the user wants it on-demand - unless ( ref($c)->config->{parse_on_demand} ) { - $c->prepare_body; + try { + # Allow engine to direct the prepare flow (for POE) + if ( my $prepare = $c->engine->can('prepare') ) { + $c->engine->$prepare( $c, @arguments ); + } + else { + $c->prepare_request(@arguments); + $c->prepare_connection; + $c->prepare_query_parameters; + $c->prepare_headers; + $c->prepare_cookies; + $c->prepare_path; + + # Prepare the body for reading, either by prepare_body + # or the user, if they are using $c->read + $c->prepare_read; + + # Parse the body unless the user wants it on-demand + unless ( ref($c)->config->{parse_on_demand} ) { + $c->prepare_body; + } } } + # VERY ugly and probably shouldn't rely on ->finalize actually working + catch { + # failed prepare is always due to an invalid request, right? + $c->response->status(400); + $c->response->content_type('text/plain'); + $c->response->body('Bad Request'); + $c->finalize; + die $_; + }; my $method = $c->req->method || ''; my $path = $c->req->path; @@@ -2242,7 -2413,12 +2266,12 @@@ Starts the engine =cut - sub run { my $c = shift; return $c->engine->run( $c, @_ ) } + sub run { + my $app = shift; + $app->engine_loader->needs_psgi_engine_compat_hack ? + $app->engine->run($app, @_) : + $app->engine->run( $app, $app->_finalized_psgi_app, @_ ); + } =head2 $c->set_action( $action, $code, $namespace, $attrs ) @@@ -2260,71 -2436,137 +2289,71 @@@ Sets up actions for a component sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) } -=head2 $c->setup_components - -This method is called internally to set up the application's components. - -It finds modules by calling the L method, expands them to -package names with the L method, and then installs -each component into the application. - -The C config option is passed to both of the above methods. - -Installation of each component is performed by the L method, -below. +=head2 $c->setup_config =cut -sub setup_components { +sub setup_config { my $class = shift; - my $config = $class->config->{ setup_components }; - - 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 ) { + my %args = %{ $class->config || {} }; - # 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 + my $container_class; - Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } ); + if ( exists $args{container_class} ) { + $container_class = delete $args{container_class}; + Class::MOP::load_class($container_class); } - - for my $component (@comps) { - my $instance = $class->components->{ $component } = $class->setup_component($component); - 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}; - $class->components->{ $component } = $class->setup_component($component); - } + else { + $container_class = Class::MOP::load_first_existing_class("${class}::Container", 'Catalyst::IOC::Container'); } -} -=head2 $c->locate_components( $setup_component_config ) + my $container = $container_class->new( %args, application_name => "$class", name => "$class" ); + $class->container($container); -This method is meant to provide a list of component modules that should be -setup for the application. By default, it will use L. + my $config = $container->resolve( service => 'config' ); + $class->config($config); + $class->finalize_config; # back-compat +} -Specify a C config option to pass additional options directly -to L. To add additional search paths, specify a key named -C as an array reference. Items in the array beginning with C<::> -will have the application class name prepended to them. +=head2 $c->finalize_config =cut -sub locate_components { - my $class = shift; - my $config = shift; - - my @paths = qw( ::Controller ::C ::Model ::M ::View ::V ); - my $extra = delete $config->{ search_extra } || []; +sub finalize_config { } - push @paths, @$extra; - - my $locator = Module::Pluggable::Object->new( - search_path => [ map { s/^(?=::)/$class/; $_; } @paths ], - %$config - ); - - # XXX think about ditching this sort entirely - my @comps = sort { length $a <=> length $b } $locator->plugins; +=head2 $c->setup_components - return @comps; -} +This method is called internally to set up the application's components. -=head2 $c->expand_component_module( $component, $setup_component_config ) +It finds modules by calling the L method, expands them to +package names with the $container->expand_component_module method, and then +installs each component into the application. -Components found by C will be passed to this method, which -is expected to return a list of component (package) names to be set up. +The C config option is passed to both of the above methods. =cut -sub expand_component_module { - my ($class, $module) = @_; - return Devel::InnerPackage::list_packages( $module ); -} +sub setup_components { shift->container->setup_components } -=head2 $c->setup_component +=head2 locate_components =cut -sub setup_component { - my( $class, $component ) = @_; - - unless ( $component->can( 'COMPONENT' ) ) { - return $component; - } +# FIXME - removed locate_components +# don't people mess with this method directly? +# what to do with that? - 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 ); }; +sub locate_components { + my $class = shift; - if ( my $error = $@ ) { - chomp $error; - Catalyst::Exception->throw( - message => qq/Couldn't instantiate component "$component", "$error"/ - ); - } + $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.'); - unless (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; + # XXX think about ditching this sort entirely + return sort { length $a <=> length $b } + @{ $class->container->resolve( service => 'locate_components' ) }; } =head2 $c->setup_dispatcher @@@ -2360,114 -2602,166 +2389,166 @@@ Sets up engine =cut + sub engine_class { + my ($class, $requested_engine) = @_; + + if (!$class->engine_loader || $requested_engine) { + $class->engine_loader( + Catalyst::EngineLoader->new({ + application_name => $class, + (defined $requested_engine + ? (requested_engine => $requested_engine) : ()), + }), + ); + } + $class->engine_loader->catalyst_engine_class; + } + sub setup_engine { - my ( $class, $engine ) = @_; + my ($class, $requested_engine) = @_; + + my $engine = $class->engine_class($requested_engine); + + # Don't really setup_engine -- see _setup_psgi_app for explanation. + return if $class->loading_psgi_file; - if ($engine) { - $engine = 'Catalyst::Engine::' . $engine; + Class::MOP::load_class($engine); + + if ($ENV{MOD_PERL}) { + my $apache = $class->engine_loader->auto; + + my $meta = find_meta($class); + my $was_immutable = $meta->is_immutable; + my %immutable_options = $meta->immutable_options; + $meta->make_mutable if $was_immutable; + + $meta->add_method(handler => sub { + my $r = shift; + my $psgi_app = $class->psgi_app; + $apache->call_app($r, $psgi_app); + }); + + $meta->make_immutable(%immutable_options) if $was_immutable; } - if ( my $env = Catalyst::Utils::env_value( $class, 'ENGINE' ) ) { - $engine = 'Catalyst::Engine::' . $env; + $class->engine( $engine->new ); + + return; + } + + sub _finalized_psgi_app { + my ($app) = @_; + + unless ($app->_psgi_app) { + my $psgi_app = $app->_setup_psgi_app; + $app->_psgi_app($psgi_app); } - if ( $ENV{MOD_PERL} ) { - my $meta = Class::MOP::get_metaclass_by_name($class); + return $app->_psgi_app; + } - # create the apache method - $meta->add_method('apache' => sub { shift->engine->apache }); + sub _setup_psgi_app { + my ($app) = @_; - my ( $software, $version ) = - $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/; + for my $home (Path::Class::Dir->new($app->config->{home})) { + my $psgi_file = $home->file( + Catalyst::Utils::appprefix($app) . '.psgi', + ); - $version =~ s/_//g; - $version =~ s/(\.[^.]+)\./$1/g; + next unless -e $psgi_file; - if ( $software eq 'mod_perl' ) { + # If $psgi_file calls ->setup_engine, it's doing so to load + # Catalyst::Engine::PSGI. But if it does that, we're only going to + # throw away the loaded PSGI-app and load the 5.9 Catalyst::Engine + # anyway. So set a flag (ick) that tells setup_engine not to populate + # $c->engine or do any other things we might regret. - if ( !$engine ) { + $app->loading_psgi_file(1); + my $psgi_app = Plack::Util::load_psgi($psgi_file); + $app->loading_psgi_file(0); - if ( $version >= 1.99922 ) { - $engine = 'Catalyst::Engine::Apache2::MP20'; - } + return $psgi_app + unless $app->engine_loader->needs_psgi_engine_compat_hack; - elsif ( $version >= 1.9901 ) { - $engine = 'Catalyst::Engine::Apache2::MP19'; - } + warn <<"EOW"; + Found a legacy Catalyst::Engine::PSGI .psgi file at ${psgi_file}. - elsif ( $version >= 1.24 ) { - $engine = 'Catalyst::Engine::Apache::MP13'; - } + Its content has been ignored. Please consult the Catalyst::Upgrading + documentation on how to upgrade from Catalyst::Engine::PSGI. + EOW + } - else { - Catalyst::Exception->throw( message => - qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ ); - } + return $app->apply_default_middlewares($app->psgi_app); + } - } + =head2 $c->apply_default_middlewares - # install the correct mod_perl handler - if ( $version >= 1.9901 ) { - *handler = sub : method { - shift->handle_request(@_); - }; - } - else { - *handler = sub ($$) { shift->handle_request(@_) }; - } + Adds the following L middlewares to your application, since they are + useful and commonly needed: - } + L, (conditionally added based on the status + of your $ENV{REMOTE_ADDR}, and can be forced on with C + or forced off with C), L + (if you are using Lighttpd), L (always + applied since this middleware is smart enough to conditionally apply itself). - elsif ( $software eq 'Zeus-Perl' ) { - $engine = 'Catalyst::Engine::Zeus'; - } + Additionally if we detect we are using Nginx, we add a bit of custom middleware + to solve some problems with the way that server handles $ENV{PATH_INFO} and + $ENV{SCRIPT_NAME} - else { - Catalyst::Exception->throw( - message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ ); - } - } + =cut - unless ($engine) { - $engine = $class->engine_class; - } - Class::MOP::load_class($engine); + sub apply_default_middlewares { + my ($app, $psgi_app) = @_; - # check for old engines that are no longer compatible - my $old_engine; - if ( $engine->isa('Catalyst::Engine::Apache') - && !Catalyst::Engine::Apache->VERSION ) - { - $old_engine = 1; - } + $psgi_app = Plack::Middleware::Conditional->wrap( + $psgi_app, + builder => sub { Plack::Middleware::ReverseProxy->wrap($_[0]) }, + condition => sub { + my ($env) = @_; + return if $app->config->{ignore_frontend_proxy}; + return $env->{REMOTE_ADDR} eq '127.0.0.1' + || $app->config->{using_frontend_proxy}; + }, + ); - elsif ( $engine->isa('Catalyst::Engine::Server::Base') - && Catalyst::Engine::Server->VERSION le '0.02' ) - { - $old_engine = 1; - } + my $server_matches = sub { + my ($re) = @_; + return sub { + my ($env) = @_; + my $server = $env->{SERVER_SOFTWARE}; + return unless $server; + return $server =~ $re ? 1 : 0; + }; + }; - elsif ($engine->isa('Catalyst::Engine::HTTP::POE') - && $engine->VERSION eq '0.01' ) - { - $old_engine = 1; - } + # If we're running under Lighttpd, swap PATH_INFO and SCRIPT_NAME + # http://lists.scsys.co.uk/pipermail/catalyst/2006-June/008361.html + $psgi_app = Plack::Middleware::LighttpdScriptNameFix->wrap($psgi_app); - elsif ($engine->isa('Catalyst::Engine::Zeus') - && $engine->VERSION eq '0.01' ) - { - $old_engine = 1; - } + # we're applying this unconditionally as the middleware itself already makes + # sure it doesn't fuck things up if it's not running under one of the right + # IIS versions + $psgi_app = Plack::Middleware::IIS6ScriptNameFix->wrap($psgi_app); - if ($old_engine) { - Catalyst::Exception->throw( message => - qq/Engine "$engine" is not supported by this version of Catalyst/ - ); - } + return $psgi_app; + } - # engine instance - $class->engine( $engine->new ); + =head2 $c->psgi_app + + Returns a PSGI application code reference for the catalyst application + C<$c>. This is the bare application without any middlewares + applied. C<${myapp}.psgi> is not taken into account. + + This is what you want to be using to retrieve the PSGI application code + reference of your Catalyst application for use in F<.psgi> files. + + =cut + + sub psgi_app { + my ($app) = @_; + return $app->engine->build_psgi_app($app); } =head2 $c->setup_home @@@ -2706,6 -3000,14 +2787,6 @@@ C - The default view to b =item * -C - Turns -off the deprecated component resolution functionality so -that if any of the component methods (e.g. C<< $c->controller('Foo') >>) -are called then regex search will not be attempted on string values and -instead C will be returned. - -=item * - C - The application home directory. In an uninstalled application, this is the top level application directory. In an installed application, this will be the directory containing C<< MyApp.pm >>. @@@ -2733,14 -3035,58 +2814,52 @@@ templates to a different directory =item * -C - Array reference passed to Module::Pluggable to for additional -namespaces from which components will be loaded (and constructed and stored in -C<< $c->components >>). - -=item * - C - If true, causes internal actions such as C<< _DISPATCH >> to be shown in hit debug tables in the test server. =item * C - Controlls if the C or C environment - variable should be used for determining the request path. See L - for more information. + variable should be used for determining the request path. + + Most web server environments pass the requested path to the application using environment variables, + from which Catalyst has to reconstruct the request base (i.e. the top level path to / in the application, + exposed as C<< $c->request->base >>) and the request path below that base. + + There are two methods of doing this, both of which have advantages and disadvantages. Which method is used + is determined by the C<< $c->config(use_request_uri_for_path) >> setting (which can either be true or false). + + =over + + =item use_request_uri_for_path => 0 + + This is the default (and the) traditional method that Catalyst has used for determining the path information. + The path is synthesised from a combination of the C and C environment variables. + The allows the application to behave correctly when C is being used to redirect requests + into the application, as these variables are adjusted by mod_rewrite to take account for the redirect. + + However this method has the major disadvantage that it is impossible to correctly decode some elements + of the path, as RFC 3875 says: "C<< Unlike a URI path, the PATH_INFO is not URL-encoded, and cannot + contain path-segment parameters. >>" This means PATH_INFO is B decoded, and therefore Catalyst + can't distinguish / vs %2F in paths (in addition to other encoded values). + + =item use_request_uri_for_path => 1 + + This method uses the C and C environment variables. As C is never + decoded, this means that applications using this mode can correctly handle URIs including the %2F character + (i.e. with C set to C in Apache). + + Given that this method of path resolution is provably more correct, it is recommended that you use + this unless you have a specific need to deploy your application in a non-standard environment, and you are + aware of the implications of not being able to handle encoded URI paths correctly. + + However it also means that in a number of cases when the app isn't installed directly at a path, but instead + is having paths rewritten into it (e.g. as a .cgi/fcgi in a public_html directory, with mod_rewrite in a + .htaccess file, or when SSI is used to rewrite pages into the app, or when sub-paths of the app are exposed + at other URIs than that which the app is 'normally' based at with C), the resolution of + C<< $c->request->base >> will be incorrect. + + =back =item * @@@ -2873,8 -3219,6 +2992,8 @@@ Andrew Ford EA.Ford@ford-mason.co.u Andrew Ruthven +André Walker + andyg: Andy Grundman audreyt: Audrey Tang diff --combined lib/Catalyst/Dispatcher.pm index 02c81e0,8451b8d..79e1309 --- a/lib/Catalyst/Dispatcher.pm +++ b/lib/Catalyst/Dispatcher.pm @@@ -308,6 -308,9 +308,6 @@@ sub _invoke_as_path sub _find_component { my ( $self, $c, $component ) = @_; - # fugly, why doesn't ->component('MyApp') work? - return $c if ($component eq blessed($c)); - return blessed($component) ? $component : $c->component($component); @@@ -735,7 -738,7 +735,7 @@@ foreach my $public_method_name (qw $package_hash{$class}++ || do { warn("Class $class is calling the deprecated method\n" . " Catalyst::Dispatcher::$public_method_name,\n" - . " this will be removed in Catalyst 5.9X\n"); + . " this will be removed in Catalyst 5.9\n"); }; }); }