X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst.pm;h=9e7d156e3db9680f18c3bc2727c7341598efe226;hp=eb44a14920c01583373aa057e0858d77c8f51f77;hb=11d52bbdb4fccbe1678d869494acb9d43ae83c99;hpb=80267996ccba9e9c1cad4fe10f4ecef33c1b1d4b

diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index eb44a14..9e7d156 100644
--- a/lib/Catalyst.pm
+++ b/lib/Catalyst.pm
@@ -4,7 +4,7 @@ use Moose;
 use Moose::Meta::Class ();
 extends 'Catalyst::Component';
 use Moose::Util qw/find_meta/;
-use B::Hooks::EndOfScope ();
+use namespace::clean -except => 'meta';
 use Catalyst::Exception;
 use Catalyst::Exception::Detach;
 use Catalyst::Exception::Go;
@@ -23,6 +23,7 @@ use Path::Class::File ();
 use URI ();
 use URI::http;
 use URI::https;
+use HTML::Entities;
 use Tree::Simple qw/use_weak_refs/;
 use Tree::Simple::Visitor::FindByUID;
 use Class::C3::Adopt::NEXT;
@@ -33,12 +34,14 @@ use Catalyst::EngineLoader;
 use utf8;
 use Carp qw/croak carp shortmess/;
 use Try::Tiny;
+use Safe::Isa;
 use Plack::Middleware::Conditional;
 use Plack::Middleware::ReverseProxy;
 use Plack::Middleware::IIS6ScriptNameFix;
+use Plack::Middleware::IIS7KeepAliveFix;
 use Plack::Middleware::LighttpdScriptNameFix;
 
-BEGIN { require 5.008004; }
+BEGIN { require 5.008003; }
 
 has stack => (is => 'ro', default => sub { [] });
 has stash => (is => 'rw', default => sub { {} });
@@ -50,20 +53,30 @@ has request => (
     is => 'rw',
     default => sub {
         my $self = shift;
-        my %p = ( _log => $self->log );
-        $p{_uploadtmp} = $self->_uploadtmp if $self->_has_uploadtmp;
-        $self->request_class->new(\%p);
+        $self->request_class->new($self->_build_request_constructor_args);
     },
     lazy => 1,
 );
+sub _build_request_constructor_args {
+    my $self = shift;
+    my %p = ( _log => $self->log );
+    $p{_uploadtmp} = $self->_uploadtmp if $self->_has_uploadtmp;
+    \%p;
+}
+
 has response => (
     is => 'rw',
     default => sub {
         my $self = shift;
-        $self->response_class->new({ _log => $self->log });
+        $self->response_class->new($self->_build_response_constructor_args);
     },
     lazy => 1,
 );
+sub _build_response_constructor_args {
+    my $self = shift;
+    { _log => $self->log };
+}
+
 has namespace => (is => 'rw');
 
 sub depth { scalar @{ shift->stack || [] }; }
@@ -100,7 +113,7 @@ __PACKAGE__->stats_class('Catalyst::Stats');
 
 # Remember to update this in Catalyst::Runtime as well!
 
-our $VERSION = '5.90008';
+our $VERSION = '5.90042';
 
 sub import {
     my ( $class, @arguments ) = @_;
@@ -135,6 +148,8 @@ sub import {
 
 sub _application { $_[0] }
 
+=encoding UTF-8
+
 =head1 NAME
 
 Catalyst - The Elegant MVC Web Application Framework
@@ -252,9 +267,9 @@ 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 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
+will try and find the directory containing either Makefile.PL, Build.PL,
+dist.ini, or cpanfile. 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 (e.g., /foo/MyApp if your
 application was installed at /foo/MyApp.pm)
 
@@ -544,13 +559,13 @@ sub _comp_names_search_prefixes {
     # undef for a name will return all
     return keys %eligible if !defined $name;
 
-    my $query  = ref $name ? $name : qr/^$name$/i;
+    my $query  = $name->$_isa('Regexp') ? $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;
+    return if $name->$_isa('Regexp');
 
     # skip regexp fallback if configured
     return
@@ -641,7 +656,7 @@ sub controller {
 
     my $appclass = ref($c) || $c;
     if( $name ) {
-        unless ( ref($name) ) { # Direct component hash lookup to avoid costly regexps
+        unless ( $name->$_isa('Regexp') ) { # 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};
@@ -679,7 +694,7 @@ sub model {
     my ( $c, $name, @args ) = @_;
     my $appclass = ref($c) || $c;
     if( $name ) {
-        unless ( ref($name) ) { # Direct component hash lookup to avoid costly regexps
+        unless ( $name->$_isa('Regexp') ) { # 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};
@@ -738,7 +753,7 @@ sub view {
 
     my $appclass = ref($c) || $c;
     if( $name ) {
-        unless ( ref($name) ) { # Direct component hash lookup to avoid costly regexps
+        unless ( $name->$_isa('Regexp') ) { # Direct component hash lookup to avoid costly regexps
             my $comps = $c->components;
             my $check = $appclass."::View::".$name;
             if( exists $comps->{$check} ) {
@@ -1184,29 +1199,6 @@ EOF
         $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
     }
 
-    # Make sure that the application class becomes immutable at this point,
-    B::Hooks::EndOfScope::on_scope_end {
-        return if $@;
-        my $meta = Class::MOP::get_metaclass_by_name($class);
-        if (
-            $meta->is_immutable
-            && ! { $meta->immutable_options }->{replace_constructor}
-            && (
-                   $class->isa('Class::Accessor::Fast')
-                || $class->isa('Class::Accessor')
-            )
-        ) {
-            warn "You made your application class ($class) immutable, "
-                . "but did not inline the\nconstructor. "
-                . "This will break catalyst, as your app \@ISA "
-                . "Class::Accessor(::Fast)?\nPlease pass "
-                . "(replace_constructor => 1)\nwhen making your class immutable.\n";
-        }
-        $meta->make_immutable(
-            replace_constructor => 1,
-        ) unless $meta->is_immutable;
-    };
-
     if ($class->config->{case_sensitive}) {
         $class->log->warn($class . "->config->{case_sensitive} is set.");
         $class->log->warn("This setting is deprecated and planned to be removed in Catalyst 5.81.");
@@ -1289,7 +1281,7 @@ path, use C<< $c->uri_for_action >> instead.
 sub uri_for {
     my ( $c, $path, @args ) = @_;
 
-    if (blessed($path) && $path->isa('Catalyst::Controller')) {
+    if ( $path->$_isa('Catalyst::Controller') ) {
         $path = $path->path_prefix;
         $path =~ s{/+\z}{};
         $path .= '/';
@@ -1306,7 +1298,7 @@ sub uri_for {
         $arg =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
     }
 
-    if ( blessed($path) ) { # action object
+    if ( $path->$_isa('Catalyst::Action') ) { # action object
         s|/|%2F|g for @args;
         my $captures = [ map { s|/|%2F|g; $_; }
                         ( scalar @args && ref $args[0] eq 'ARRAY'
@@ -1350,9 +1342,13 @@ sub uri_for {
     my $args = join('/', grep { defined($_) } @args);
     $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
     $args =~ s!^/+!!;
-    my $base = $c->req->base;
-    my $class = ref($base);
-    $base =~ s{(?<!/)$}{/};
+
+    my ($base, $class) = ('/', 'URI::_generic');
+    if(blessed($c)) {
+      $base = $c->req->base;
+      $class = ref($base);
+      $base =~ s{(?<!/)$}{/};
+    }
 
     my $query = '';
 
@@ -1797,6 +1793,14 @@ sub finalize {
         $c->log->error($error);
     }
 
+    # Support skipping finalize for psgix.io style 'jailbreak'.  Used to support
+    # stuff like cometd and websockets
+    
+    if($c->request->has_io_fh) {
+      $c->log_response;
+      return;
+    }
+
     # Allow engine to handle finalize flow (for POE)
     my $engine = $c->engine;
     if ( my $code = $engine->can('finalize') ) {
@@ -1811,7 +1815,7 @@ sub finalize {
             $c->finalize_error;
         }
 
-        $c->finalize_headers;
+        $c->finalize_headers unless $c->response->finalized_headers;
 
         # HEAD request
         if ( $c->request->method eq 'HEAD' ) {
@@ -1824,7 +1828,7 @@ sub finalize {
     $c->log_response;
 
     if ($c->use_stats) {
-        my $elapsed = sprintf '%f', $c->stats->elapsed;
+        my $elapsed = $c->stats->elapsed;
         my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
         $c->log->info(
             "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" );
@@ -1878,6 +1882,7 @@ sub finalize_headers {
 
         if ( !$response->has_body ) {
             # Add a default body if none is already present
+            my $encoded_location = encode_entities($location);
             $response->body(<<"EOF");
 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
 <html xmlns="http://www.w3.org/1999/xhtml"> 
@@ -1885,7 +1890,7 @@ sub finalize_headers {
     <title>Moved</title>
   </head>
   <body>
-     <p>This item has moved <a href="$location">here</a>.</p>
+     <p>This item has moved <a href="$encoded_location">here</a>.</p>
   </body>
 </html>
 EOF
@@ -1921,7 +1926,7 @@ EOF
 
     $c->finalize_cookies;
 
-    $c->engine->finalize_headers( $c, @_ );
+    $c->response->finalize_headers();
 
     # Done
     $response->finalized_headers(1);
@@ -2023,6 +2028,8 @@ sub prepare {
     my $uploadtmp = $class->config->{uploadtmp};
     my $c = $class->context_class->new({ $uploadtmp ? (_uploadtmp => $uploadtmp) : ()});
 
+    $c->response->_context($c);
+
     #surely this is not the most efficient way to do things...
     $c->stats($class->stats_class->new)->enable($c->use_stats);
     if ( $c->debug || $c->config->{enable_catalyst_header} ) {
@@ -2446,11 +2453,35 @@ Starts the engine.
 
 sub run {
   my $app = shift;
+  $app->_make_immutable_if_needed;
   $app->engine_loader->needs_psgi_engine_compat_hack ?
     $app->engine->run($app, @_) :
       $app->engine->run( $app, $app->_finalized_psgi_app, @_ );
 }
 
+sub _make_immutable_if_needed {
+    my $class = shift;
+    my $meta = Class::MOP::get_metaclass_by_name($class);
+    my $isa_ca = $class->isa('Class::Accessor::Fast') || $class->isa('Class::Accessor');
+    if (
+        $meta->is_immutable
+        && ! { $meta->immutable_options }->{replace_constructor}
+        && $isa_ca
+    ) {
+        warn("You made your application class ($class) immutable, "
+            . "but did not inline the\nconstructor. "
+            . "This will break catalyst, as your app \@ISA "
+            . "Class::Accessor(::Fast)?\nPlease pass "
+            . "(replace_constructor => 1)\nwhen making your class immutable.\n");
+    }
+    unless ($meta->is_immutable) {
+        # XXX - FIXME warning here as you should make your app immutable yourself.
+        $meta->make_immutable(
+            replace_constructor => 1,
+        );
+    }
+}
+
 =head2 $c->set_action( $action, $code, $namespace, $attrs )
 
 Sets an action in a given namespace.
@@ -2790,6 +2821,16 @@ sub apply_default_middlewares {
     # IIS versions
     $psgi_app = Plack::Middleware::IIS6ScriptNameFix->wrap($psgi_app);
 
+    # And another IIS issue, this time with IIS7.
+    $psgi_app = Plack::Middleware::Conditional->wrap(
+        $psgi_app,
+        builder => sub { Plack::Middleware::IIS7KeepAliveFix->wrap($_[0]) },
+        condition => sub {
+            my ($env) = @_;
+            return $env->{SERVER_SOFTWARE} && $env->{SERVER_SOFTWARE} =~ m!IIS/7\.[0-9]!;
+        },
+    );
+
     return $psgi_app;
 }
 
@@ -2928,18 +2969,39 @@ the plugin name does not begin with C<Catalyst::Plugin::>.
         Class::MOP::load_class( $plugin );
         $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) {
+        my $plugin_meta = Moose::Meta::Class->create($plugin);
+        if (!$plugin_meta->has_method('new')
+            && ( $plugin->isa('Class::Accessor::Fast') || $plugin->isa('Class::Accessor') ) ) {
+            $plugin_meta->add_method('new', Moose::Object->meta->get_method('new'))
+        }
+        if (!$instant && !$proto->_plugins->{$plugin}) {
             my $meta = Class::MOP::get_metaclass_by_name($class);
             $meta->superclasses($plugin, $meta->superclasses);
         }
+        $proto->_plugins->{$plugin} = 1;
         return $class;
     }
 
+    sub _default_plugins { return qw(Unicode::Encoding) }
+
     sub setup_plugins {
         my ( $class, $plugins ) = @_;
 
         $class->_plugins( {} ) unless $class->_plugins;
+        $plugins = [ grep {
+            m/Unicode::Encoding/ ? do {
+                $class->log->warn(
+                    'Unicode::Encoding plugin is auto-applied,'
+                    . ' please remove this from your appclass'
+                    . ' and make sure to define "encoding" config'
+                );
+                unless (exists $class->config->{'encoding'}) {
+                  $class->config->{'encoding'} = 'UTF-8';
+                }
+                () }
+                : $_
+        } @$plugins ];
+        push @$plugins, $class->_default_plugins;
         $plugins = Data::OptList::mkopt($plugins || []);
 
         my @plugins = map {
@@ -3131,12 +3193,33 @@ is having paths rewritten into it (e.g. as a .cgi/fcgi in a public_html director
 at other URIs than that which the app is 'normally' based at with C<mod_rewrite>), the resolution of
 C<< $c->request->base >> will be incorrect.
 
-=back
+=back 
 
 =item *
 
 C<using_frontend_proxy> - See L</PROXY SUPPORT>.
 
+=item *
+
+C<encoding> - See L</ENCODING>
+
+=item *
+
+C<abort_chain_on_error_fix>
+
+When there is an error in an action chain, the default behavior is to continue
+processing the remaining actions and then catch the error upon chain end.  This
+can lead to running actions when the application is in an unexpected state.  If
+you have this issue, setting this config value to true will promptly exit a
+chain when there is an error raised in any action (thus terminating the chain 
+early.)
+
+use like:
+
+    __PACKAGE__->config(abort_chain_on_error_fix => 1);
+
+In the future this might become the default behavior.
+
 =back
 
 =head1 INTERNAL ACTIONS
@@ -3228,6 +3311,53 @@ If you plan to operate in a threaded environment, remember that all other
 modules you are using must also be thread-safe. Some modules, most notably
 L<DBD::SQLite>, are not thread-safe.
 
+=head1 ENCODING
+
+On request, decodes all params from encoding into a sequence of
+logical characters. On response, encodes body into encoding.
+
+=head2 Methods
+
+=over 4
+
+=item encoding
+
+Returns an instance of an C<Encode> encoding
+
+    print $c->encoding->name
+
+=item handle_unicode_encoding_exception ($exception_context)
+
+Method called when decoding process for a request fails.
+
+An C<$exception_context> hashref is provided to allow you to override the
+behaviour of your application when given data with incorrect encodings.
+
+The default method throws exceptions in the case of invalid request parameters
+(resulting in a 500 error), but ignores errors in upload filenames.
+
+The keys passed in the C<$exception_context> hash are:
+
+=over
+
+=item param_value
+
+The value which was not able to be decoded.
+
+=item error_msg
+
+The exception received from L<Encode>.
+
+=item encoding_step
+
+What type of data was being decoded. Valid values are (currently)
+C<params> - for request parameters / arguments / captures
+and C<uploads> - for request upload filenames.
+
+=back
+
+=back
+
 =head1 SUPPORT
 
 IRC:
@@ -3355,6 +3485,8 @@ marcus: Marcus Ramberg <mramberg@cpan.org>
 
 miyagawa: Tatsuhiko Miyagawa <miyagawa@bulknews.net>
 
+mgrimes: Mark Grimes <mgrimes@cpan.org>
+
 mst: Matt S. Trout <mst@shadowcatsystems.co.uk>
 
 mugwump: Sam Vilain
@@ -3399,7 +3531,7 @@ Will Hawes C<info@whawes.co.uk>
 
 willert: Sebastian Willert <willert@cpan.org>
 
-wreis: Wallace Reis <wallace@reis.org.br>
+wreis: Wallace Reis <wreis@cpan.org>
 
 Yuval Kogman, C<nothingmuch@woobling.org>