X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst.pm;h=8f91b31381a95b798aa231ef055b3cbb43a6904d;hb=7c7954572cfa0a81c6cea8c15c6110386b851418;hp=c0683b8f64052570f2458b6677a59a8fedd6f3d4;hpb=bd6fe28d98bf906aab78aee7c0a246533e76e169;p=catagits%2FCatalyst-Runtime.git

diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index c0683b8..8f91b31 100644
--- a/lib/Catalyst.pm
+++ b/lib/Catalyst.pm
@@ -16,7 +16,6 @@ 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 ();
@@ -30,9 +29,14 @@ 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; }
 
@@ -70,18 +74,17 @@ our $GO        = Catalyst::Exception::Go->new;
 #maybe we should just make them attributes with a default?
 __PACKAGE__->mk_classdata($_)
   for qw/components arguments dispatcher engine log dispatcher_class
-  engine_class context_class request_class response_class stats_class
-  setup_finished psgi_app/;
+  engine_loader context_class request_class response_class stats_class
+  setup_finished _psgi_app loading_psgi_file/;
 
 __PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
-__PACKAGE__->engine_class('Catalyst::Engine');
 __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.80024';
+our $VERSION = '5.89003';
 
 sub import {
     my ( $class, @arguments ) = @_;
@@ -102,7 +105,12 @@ sub import {
     $meta->superclasses(grep { $_ ne 'Moose::Object' } $meta->superclasses);
 
     unless( $meta->has_method('meta') ){
-        $meta->add_method(meta => sub { Moose::Meta::Class->initialize("${caller}") } );
+        if ($Moose::VERSION >= 1.15) {
+            $meta->_add_meta_method('meta');
+        }
+        else {
+            $meta->add_method(meta => sub { Moose::Meta::Class->initialize("${caller}") } );
+        }
     }
 
     $caller->arguments( [@arguments] );
@@ -268,11 +276,11 @@ the name will be replaced with underscores, e.g. MyApp::Web should use
 MYAPP_WEB_HOME. If both variables are set, the MYAPP_HOME one will be used.
 
 If none of these are set, Catalyst will attempt to automatically detect the
-home directory. If you are working in a development envirnoment, Catalyst
+home directory. If you are working in a development environment, Catalyst
 will try and find the directory containing either Makefile.PL, Build.PL or
 dist.ini. If the application has been installed into the system (i.e.
 you have done C<make install>), then Catalyst will use the path to your
-application module, without the .pm extension (ie, /foo/MyApp if your
+application module, without the .pm extension (e.g., /foo/MyApp if your
 application was installed at /foo/MyApp.pm)
 
 =head2 -Log
@@ -340,9 +348,10 @@ call to forward.
 
 Note that L<< forward|/"$c->forward( $action [, \@arguments ] )" >> implies
 an C<< eval { } >> around the call (actually
-L<< execute|/"$c->execute( $class, $coderef )" >> does), thus de-fatalizing
-all 'dies' within the called action. If you want C<die> to propagate you
-need to do something like:
+L<< execute|/"$c->execute( $class, $coderef )" >> does), thus rendering all
+exceptions thrown by the called action non-fatal and pushing them onto
+$c->error instead. If you want C<die> to propagate you need to do something
+like:
 
     $c->forward('foo');
     die join "\n", @{ $c->error } if @{ $c->error };
@@ -367,6 +376,8 @@ or stash it like so:
 
 and access it from the stash.
 
+Keep in mind that the C<end> method used is that of the caller action. So a C<$c-E<gt>detach> inside a forwarded action would run the C<end> method from the original action requested.
+
 =cut
 
 sub forward { my $c = shift; no warnings 'recursion'; $c->dispatcher->forward( $c, @_ ) }
@@ -402,7 +413,7 @@ L<reverse|Catalyst::Action/reverse> return information for the visited action
 when they are invoked within the visited action.  This is different from the
 behavior of L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, which
 continues to use the $c->action object from the caller action even when
-invoked from the callee.
+invoked from the called action.
 
 C<< $c->stash >> is kept unchanged.
 
@@ -430,6 +441,10 @@ with localized C<< $c->action >> and C<< $c->namespace >>. Like C<detach>,
 C<go> escapes the processing of the current request chain on completion, and
 does not return to its caller.
 
+@arguments are arguments to the final destination of $action. @captures are
+arguments to the intermediate steps, if any, on the way to the final sub of
+$action.
+
 =cut
 
 sub go { my $c = shift; $c->dispatcher->go( $c, @_ ) }
@@ -743,7 +758,12 @@ sub view {
         unless ( ref($name) ) { # Direct component hash lookup to avoid costly regexps
             my $comps = $c->components;
             my $check = $appclass."::View::".$name;
-            return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
+            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;
@@ -847,6 +867,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;
 
@@ -894,7 +917,7 @@ component is constructed.
 For example:
 
     MyApp->config({ 'Model::Foo' => { bar => 'baz', overrides => 'me' } });
-    MyApp::Model::Foo->config({ quux => 'frob', 'overrides => 'this' });
+    MyApp::Model::Foo->config({ quux => 'frob', overrides => 'this' });
 
 will mean that C<MyApp::Model::Foo> receives the following data when
 constructed:
@@ -905,6 +928,27 @@ constructed:
         overrides => 'me',
     });
 
+It's common practice to use a Moose attribute
+on the receiving component to access the config value.
+
+    package MyApp::Model::Foo;
+
+    use Moose;
+
+    # this attr will receive 'baz' at construction time
+    has 'bar' => (
+        is  => 'rw',
+        isa => 'Str',
+    );
+
+You can then get the value 'baz' by calling $c->model('Foo')->bar
+(or $self->bar inside code in the model).
+
+B<NOTE:> you MUST NOT call C<< $self->config >> or C<< __PACKAGE__->config >>
+as a way of reading config within your code, as this B<will not> give you the
+correctly merged config back. You B<MUST> take the config values supplied to
+the constructor and use those instead.
+
 =cut
 
 around config => sub {
@@ -1079,7 +1123,10 @@ sub setup {
     $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} ) {
@@ -1206,7 +1253,7 @@ EOF
 A hook to attach modifiers to. This method does not do anything except set the
 C<setup_finished> accessor.
 
-Applying method modifiers to the C<setup> method doesn't work, because of quirky thingsdone for plugin setup.
+Applying method modifiers to the C<setup> method doesn't work, because of quirky things done for plugin setup.
 
 Example:
 
@@ -1229,7 +1276,9 @@ sub setup_finalize {
 
 Constructs an absolute L<URI> object based on the application root, the
 provided path, and the additional arguments and query parameters provided.
-When used as a string, provides a textual URI.
+When used as a string, provides a textual URI.  If you need more flexibility
+than this (i.e. the option to provide relative URIs etc.) see
+L<Catalyst::Plugin::SmartURI>.
 
 If no arguments are provided, the URI for the current action is returned.
 To return the current action and also provide @args, use
@@ -1623,7 +1672,9 @@ sub execute {
     push( @{ $c->stack }, $code );
 
     no warnings 'recursion';
-    eval { $c->state( $code->execute( $class, $c, @{ $c->req->args } ) || 0 ) };
+    # N.B. This used to be combined, but I have seen $c get clobbered if so, and
+    #      I have no idea how, ergo $ret (which appears to fix the issue)
+    eval { my $ret = $code->execute( $class, $c, @{ $c->req->args } ) || 0; $c->state( $ret ) };
 
     $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
 
@@ -1645,8 +1696,8 @@ sub execute {
                 $error = qq/Caught exception in $class->$name "$error"/;
             }
             $c->error($error);
-            $c->state(0);
         }
+        $c->state(0);
     }
     return $c->state;
 }
@@ -1686,7 +1737,7 @@ sub _stats_start_execute {
         my $parent = $c->stack->[-1];
 
         # forward, locate the caller
-        if ( exists $c->counter->{"$parent"} ) {
+        if ( defined $parent && exists $c->counter->{"$parent"} ) {
             $c->stats->profile(
                 begin  => $action,
                 parent => "$parent" . $c->counter->{"$parent"},
@@ -1820,14 +1871,14 @@ sub finalize_headers {
     }
 
     # Content-Length
-    if ( $response->body && !$response->content_length ) {
+    if ( defined $response->body && length $response->body && !$response->content_length ) {
 
         # get the length from a filehandle
-        if ( blessed( $response->body ) && $response->body->can('read') )
+        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');
@@ -2144,7 +2195,7 @@ sub log_request {
         $c->log->debug("Query keywords are: $keywords");
     }
 
-    $c->log_request_parameters( query => $request->query_parameters, body => $request->body_parameters );
+    $c->log_request_parameters( query => $request->query_parameters, $request->_has_body ? (body => $request->body_parameters) : () );
 
     $c->log_request_uploads($request);
 }
@@ -2199,7 +2250,7 @@ sub log_response_status_line {
 
 =head2 $c->log_response_headers($headers);
 
-Hook method which can be wrapped by plugins to log the responseheaders.
+Hook method which can be wrapped by plugins to log the response headers.
 No-op in the default implementation.
 
 =cut
@@ -2334,11 +2385,11 @@ sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
 
 =head2 $c->request_class
 
-Returns or sets the request class.
+Returns or sets the request class. Defaults to L<Catalyst::Request>.
 
 =head2 $c->response_class
 
-Returns or sets the response class.
+Returns or sets the response class. Defaults to L<Catalyst::Response>.
 
 =head2 $c->read( [$maxlength] )
 
@@ -2363,7 +2414,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 )
 
@@ -2401,8 +2457,7 @@ sub setup_components {
 
     my $config  = $class->config->{ setup_components };
 
-    my @comps = sort { length $a <=> length $b }
-                $class->locate_components($config);
+    my @comps = $class->locate_components($config);
     my %comps = map { $_ => 1 } @comps;
 
     my $deprecatedcatalyst_component_names = grep { /::[CMV]::/ } @comps;
@@ -2457,7 +2512,8 @@ sub locate_components {
         %$config
     );
 
-    my @comps = $locator->plugins;
+    # XXX think about ditching this sort entirely
+    my @comps = sort { length $a <=> length $b } $locator->plugins;
 
     return @comps;
 }
@@ -2547,66 +2603,177 @@ Sets up engine.
 
 =cut
 
-sub setup_engine {
-    my ($class, $engine) = @_;
+sub engine_class {
+    my $class = shift;
+    $class->engine_loader->catalyst_engine_class(@_);
+}
 
-    unless ($engine) {
-        $engine = $class->engine_class;
-    }
-    else {
-        $engine = String::RewritePrefix->rewrite( { '' => 'Catalyst::Engine::', '+' => '' }, $engine );
-    }
+sub setup_engine {
+    my ($class, $requested_engine) = @_;
+
+    $class->engine_loader(
+        Catalyst::EngineLoader->new({
+            application_name => $class,
+            (defined $requested_engine
+                 ? (requested_engine => $requested_engine) : ()),
+        }),
+    );
 
-    $engine = 'Catalyst::Engine' if $engine eq 'Catalyst::Engine::HTTP';
+    # Don't really setup_engine -- see _setup_psgi_app for explanation.
+    return if $class->loading_psgi_file;
 
+    my $engine = $class->engine_class;
     Class::MOP::load_class($engine);
 
-    # 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;
-    }
+    if ($ENV{MOD_PERL}) {
+        my $apache = $class->engine_loader->auto;
 
-    elsif ( $engine->isa('Catalyst::Engine::Server::Base')
-        && Catalyst::Engine::Server->VERSION le '0.02' )
-    {
-        $old_engine = 1;
-    }
+        my $meta = find_meta($class);
+        my $was_immutable = $meta->is_immutable;
+        my %immutable_options = $meta->immutable_options;
+        $meta->make_mutable if $was_immutable;
 
-    elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
-        && $engine->VERSION eq '0.01' )
-    {
-        $old_engine = 1;
+        $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;
     }
 
-    elsif ($engine->isa('Catalyst::Engine::Zeus')
-        && $engine->VERSION eq '0.01' )
-    {
-        $old_engine = 1;
+    $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 ($old_engine) {
-        Catalyst::Exception->throw( message =>
-              qq/Engine "$engine" is not supported by this version of Catalyst/
+    return $app->_psgi_app;
+}
+
+sub _setup_psgi_app {
+    my ($app) = @_;
+
+    for my $home (Path::Class::Dir->new($app->config->{home})) {
+        my $psgi_file = $home->file(
+            Catalyst::Utils::appprefix($app) . '.psgi',
         );
-    }
 
-    if ($ENV{MOD_PERL}) {
-        require 'Catalyst/Engine/Loader.pm';
-        my $apache = Catalyst::Engine::Loader->auto;
-        # FIXME - Immutable
-        $class->meta->add_method(handler => sub {
-            my $r = shift;
-            my $app = $class->psgi_app;
-            $apache->call_app($r, $app);
-        });
+        next unless -e $psgi_file;
+
+        # 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.
+
+        $app->loading_psgi_file(1);
+        my $psgi_app = Plack::Util::load_psgi($psgi_file);
+        $app->loading_psgi_file(0);
+
+        return $psgi_app
+            unless $app->engine_loader->needs_psgi_engine_compat_hack;
+
+        warn <<"EOW";
+Found a legacy Catalyst::Engine::PSGI .psgi file at ${psgi_file}.
+
+Its content has been ignored. Please consult the Catalyst::Upgrading
+documentation on how to upgrade from Catalyst::Engine::PSGI.
+EOW
     }
 
-    $class->engine( $engine->new );
-    $class->psgi_app( $class->engine->build_psgi_app($class) );
+    return $app->apply_default_middlewares($app->psgi_app);
+}
+
+=head2 $c->apply_default_middlewares
+
+Adds the following L<Plack> middlewares to your application, since they are
+useful and commonly needed:
+
+L<Plack::Middleware::ReverseProxy>, (conditionally added based on the status
+of your $ENV{REMOTE_ADDR}, and can be forced on with C<using_frontend_proxy>
+or forced off with C<ignore_frontend_proxy>), L<Plack::Middleware::LighttpdScriptNameFix>
+(if you are using Lighttpd), L<Plack::Middleware::IIS6ScriptNameFix> (always
+applied since this middleware is smart enough to conditionally apply itself).
+
+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}
+
+=cut
+
 
+sub apply_default_middlewares {
+    my ($app, $psgi_app) = @_;
+
+    $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};
+        },
+    );
+
+    my $server_matches = sub {
+        my ($re) = @_;
+        return sub {
+            my ($env) = @_;
+            my $server = $env->{SERVER_SOFTWARE};
+            return unless $server;
+            return $server =~ $re ? 1 : 0;
+        };
+    };
+
+    # 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);
+
+    $psgi_app = Plack::Middleware::Conditional->wrap(
+        $psgi_app,
+        condition => $server_matches->(qr/^nginx/),
+        builder   => sub {
+            my ($to_wrap) = @_;
+            return sub {
+                my ($env) = @_;
+                my $script_name = $env->{SCRIPT_NAME};
+                $env->{PATH_INFO} =~ s/^$script_name//g;
+                return $to_wrap->($env);
+            };
+        },
+    );
+
+    # 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);
+
+    return $psgi_app;
+}
+
+=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
@@ -2726,7 +2893,7 @@ the plugin name does not begin with C<Catalyst::Plugin::>.
         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) {
@@ -2870,7 +3037,7 @@ welcome screens
 
 C<parse_on_demand> - The request body (for example file uploads) will not be parsed
 until it is accessed. This allows you to (for example) check authentication (and reject
-the upload) before actually recieving all the data. See L</ON-DEMAND PARSER>
+the upload) before actually receiving all the data. See L</ON-DEMAND PARSER>
 
 =item *
 
@@ -2891,7 +3058,7 @@ to be shown in hit debug tables in the test server.
 
 =item *
 
-C<use_request_uri_for_path> - Controlls if the C<REQUEST_URI> or C<PATH_INFO> environment
+C<use_request_uri_for_path> - Controls if the C<REQUEST_URI> or C<PATH_INFO> environment
 variable should be used for determining the request path. See L<Catalyst::Engine::CGI/PATH DECODING>
 for more information.
 
@@ -3008,6 +3175,8 @@ Wiki:
 
 =head2 L<Catalyst::Test> - The test suite.
 
+=begin stopwords
+
 =head1 PROJECT FOUNDER
 
 sri: Sebastian Riedel <sri@cpan.org>
@@ -3146,6 +3315,16 @@ wreis: Wallace Reis <wallace@reis.org.br>
 
 Yuval Kogman, C<nothingmuch@woobling.org>
 
+rainboxx: Matthias Dietrich, C<perl@rainboxx.de>
+
+dd070: Dhaval Dhanani <dhaval070@gmail.com>
+
+=end stopwords
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005, the above named PROJECT FOUNDER and CONTRIBUTORS.
+
 =head1 LICENSE
 
 This library is free software. You can redistribute it and/or modify it under