X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst.pm;h=1b73f235b2b96b81d8d4c10906ab387fef79c4a7;hp=c4d915a9a3179e7f50721ec04ae0bb330b04d684;hb=0ca510f0aa1cabe138d81897d38111d7b772449c;hpb=4c166e20acda56c8d07834ee14b010fd13bffe4d diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index c4d915a..1b73f23 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,21 +34,62 @@ use Catalyst::EngineLoader; use utf8; use Carp qw/croak carp shortmess/; use Try::Tiny; +use Safe::Isa; +use Moose::Util 'find_meta'; use Plack::Middleware::Conditional; use Plack::Middleware::ReverseProxy; use Plack::Middleware::IIS6ScriptNameFix; +use Plack::Middleware::IIS7KeepAliveFix; use Plack::Middleware::LighttpdScriptNameFix; - -BEGIN { require 5.008004; } +use Plack::Middleware::ContentLength; +use Plack::Middleware::Head; +use Plack::Middleware::HTTPExceptions; +use Plack::Middleware::FixMissingBodyInRedirect; +use Plack::Middleware::MethodOverride; +use Plack::Middleware::RemoveRedundantBody; +use Catalyst::Middleware::Stash; +use Plack::Util; +use Class::Load 'load_class'; +use Encode 2.21 'decode_utf8', 'encode_utf8'; + +BEGIN { require 5.008003; } has stack => (is => 'ro', default => sub { [] }); -has stash => (is => 'rw', default => sub { {} }); has state => (is => 'rw', default => 0); has stats => (is => 'rw'); has action => (is => 'rw'); has counter => (is => 'rw', default => sub { {} }); -has request => (is => 'rw', default => sub { $_[0]->request_class->new({}) }, required => 1, lazy => 1); -has response => (is => 'rw', default => sub { $_[0]->response_class->new({}) }, required => 1, lazy => 1); +has request => ( + is => 'rw', + default => sub { + my $self = shift; + $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{data_handlers} = {$self->registered_data_handlers}; + $p{_use_hash_multivalue} = $self->config->{use_hash_multivalue_in_request} + if $self->config->{use_hash_multivalue_in_request}; + \%p; +} + +has response => ( + is => 'rw', + default => sub { + my $self = shift; + $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 || [] }; } @@ -75,16 +117,18 @@ our $GO = Catalyst::Exception::Go->new; __PACKAGE__->mk_classdata($_) 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 run_options/; + setup_finished _psgi_app loading_psgi_file run_options _psgi_middleware + _data_handlers _encoding _encode_check/; __PACKAGE__->dispatcher_class('Catalyst::Dispatcher'); __PACKAGE__->request_class('Catalyst::Request'); __PACKAGE__->response_class('Catalyst::Response'); __PACKAGE__->stats_class('Catalyst::Stats'); +__PACKAGE__->_encode_check(Encode::FB_CROAK | Encode::LEAVE_SRC); # Remember to update this in Catalyst::Runtime as well! - -our $VERSION = '5.90006'; +our $VERSION = '5.90080_001'; +$VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases sub import { my ( $class, @arguments ) = @_; @@ -119,6 +163,8 @@ sub import { sub _application { $_[0] } +=encoding UTF-8 + =head1 NAME Catalyst - The Elegant MVC Web Application Framework @@ -236,9 +282,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), 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), 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) @@ -291,7 +337,18 @@ cookies, HTTP headers, etc.). See L. =head2 $c->forward( $class, $method, [, \@arguments ] ) -Forwards processing to another action, by its private name. If you give a +This is one way of calling another action (method) in the same or +a different controller. You can also use C<< $self->my_method($c, @args) >> +in the same controller or C<< $c->controller('MyController')->my_method($c, @args) >> +in a different controller. +The main difference is that 'forward' uses some of the Catalyst request +cycle overhead, including debugging, which may be useful to you. On the +other hand, there are some complications to using 'forward', restrictions +on values returned from 'forward', and it may not handle errors as you prefer. +Whether you use 'forward' or not is up to you; it is not considered superior to +the other ways to call a method. + +'forward' calls another action, by its private name. If you give a class name but no method, C is called. You may also optionally pass arguments in an arrayref. The action will receive the arguments in C<@_> and C<< $c->req->args >>. Upon returning from the function, @@ -356,8 +413,12 @@ When called with no arguments it escapes the processing chain entirely. sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) } +=head2 $c->visit( $action [, \@arguments ] ) + =head2 $c->visit( $action [, \@captures, \@arguments ] ) +=head2 $c->visit( $class, $method, [, \@arguments ] ) + =head2 $c->visit( $class, $method, [, \@captures, \@arguments ] ) Almost the same as L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, @@ -386,8 +447,12 @@ transfer control to another action as if it had been reached directly from a URL sub visit { my $c = shift; $c->dispatcher->visit( $c, @_ ) } +=head2 $c->go( $action [, \@arguments ] ) + =head2 $c->go( $action [, \@captures, \@arguments ] ) +=head2 $c->go( $class, $method, [, \@arguments ] ) + =head2 $c->go( $class, $method, [, \@captures, \@arguments ] ) The relationship between C and @@ -431,23 +496,24 @@ Catalyst). # stash is automatically passed to the view for use in a template $c->forward( 'MyApp::View::TT' ); -=cut +The stash hash is currently stored in the PSGI C<$env> and is managed by +L. Since it's part of the C<$env> items in +the stash can be accessed in sub applications mounted under your main +L application. For example if you delegate the response of an +action to another L application, that sub application will have +access to all the stash keys of the main one, and if can of course add +more keys of its own. However those new keys will not 'bubble' back up +to the main application. -around stash => sub { - my $orig = shift; - my $c = shift; - my $stash = $orig->($c); - if (@_) { - my $new_stash = @_ > 1 ? {@_} : $_[0]; - croak('stash takes a hash or hashref') unless ref $new_stash; - foreach my $key ( keys %$new_stash ) { - $stash->{$key} = $new_stash->{$key}; - } - } +For more information the best thing to do is to review the test case: +t/middleware-stash.t in the distribution /t directory. - return $stash; -}; +=cut +sub stash { + my $c = shift; + return Catalyst::Middleware::Stash::get_stash($c->req->env)->(@_); +} =head2 $c->error @@ -501,6 +567,14 @@ sub clear_errors { $c->error(0); } +=head2 $c->has_errors + +Returns true if you have errors + +=cut + +sub has_errors { scalar(@{shift->error}) ? 1:0 } + sub _comp_search_prefixes { my $c = shift; return map $c->components->{ $_ }, $c->_comp_names_search_prefixes(@_); @@ -520,13 +594,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 @@ -617,7 +691,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}; @@ -655,7 +729,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}; @@ -714,7 +788,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} ) { @@ -937,6 +1011,38 @@ And later: Your log class should implement the methods described in L. +=head2 encoding + +Sets or gets the application encoding. + +=cut + +sub encoding { + my $c = shift; + my $encoding; + + if ( scalar @_ ) { + # Let it be set to undef + if (my $wanted = shift) { + $encoding = Encode::find_encoding($wanted) + or Carp::croak( qq/Unknown encoding '$wanted'/ ); + binmode(STDERR, ':encoding(' . $encoding->name . ')'); + } + else { + binmode(STDERR); + } + + $encoding = ref $c + ? $c->{encoding} = $encoding + : $c->_encoding($encoding); + } else { + $encoding = ref $c && exists $c->{encoding} + ? $c->{encoding} + : $c->_encoding; + } + + return $encoding; +} =head2 $c->debug @@ -1069,6 +1175,8 @@ sub setup { $class->setup_log( delete $flags->{log} ); $class->setup_plugins( delete $flags->{plugins} ); + + $class->setup_data_handlers(); $class->setup_dispatcher( delete $flags->{dispatcher} ); if (my $engine = delete $flags->{engine}) { $class->log->warn("Specifying the engine in ->setup is no longer supported, see Catalyst::Upgrading"); @@ -1100,6 +1208,26 @@ You are running an old script! EOF } + # Call plugins setup, this is stupid and evil. + # Also screws C3 badly on 5.10, hack to avoid. + { + no warnings qw/redefine/; + local *setup = sub { }; + $class->setup unless $Catalyst::__AM_RESTARTING; + } + + # If you are expecting configuration info as part of your setup, it needs + # to get called here and below, since we need the above line to support + # ConfigLoader based configs. + + $class->setup_encoding(); + $class->setup_middleware(); + + # Initialize our data structure + $class->components( {} ); + + $class->setup_components; + if ( $class->debug ) { my @plugins = map { "$_ " . ( $_->VERSION || '' ) } $class->registered_plugins; @@ -1110,6 +1238,27 @@ EOF $class->log->debug( "Loaded plugins:\n" . $t->draw . "\n" ); } + my @middleware = map { + ref $_ eq 'CODE' ? + "Inline Coderef" : + (ref($_) .' '. ($_->can('VERSION') ? $_->VERSION || '' : '') + || '') } $class->registered_middlewares; + + if (@middleware) { + my $column_width = Catalyst::Utils::term_width() - 6; + my $t = Text::SimpleTable->new($column_width); + $t->row($_) for @middleware; + $class->log->debug( "Loaded PSGI Middleware:\n" . $t->draw . "\n" ); + } + + my %dh = $class->registered_data_handlers; + if (my @data_handlers = keys %dh) { + my $column_width = Catalyst::Utils::term_width() - 6; + my $t = Text::SimpleTable->new($column_width); + $t->row($_) for @data_handlers; + $class->log->debug( "Loaded Request Data Handlers:\n" . $t->draw . "\n" ); + } + my $dispatcher = $class->dispatcher; my $engine = $class->engine; my $home = $class->config->{home}; @@ -1122,22 +1271,7 @@ EOF ? $class->log->debug(qq/Found home "$home"/) : $class->log->debug(qq/Home "$home" doesn't exist/) : $class->log->debug(q/Couldn't find home/); - } - # Call plugins setup, this is stupid and evil. - # Also screws C3 badly on 5.10, hack to avoid. - { - no warnings qw/redefine/; - local *setup = sub { }; - $class->setup unless $Catalyst::__AM_RESTARTING; - } - - # Initialize our data structure - $class->components( {} ); - - $class->setup_components; - - if ( $class->debug ) { 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 } ) { @@ -1160,39 +1294,17 @@ 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."); } $class->setup_finalize; - # Should be the last thing we do so that user things hooking - # setup_finalize can log.. + + # Flush the log for good measure (in case something turned off 'autoflush' early) $class->log->_flush() if $class->log->can('_flush'); - return 1; # Explicit return true as people have __PACKAGE__->setup as the last thing in their class. HATE. + + return $class || 1; # Just in case someone named their Application 0... } =head2 $app->setup_finalize @@ -1265,7 +1377,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 .= '/'; @@ -1277,30 +1389,38 @@ sub uri_for { ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} ); carp "uri_for called with undef argument" if grep { ! defined $_ } @args; + + my @encoded_args = (); foreach my $arg (@args) { - utf8::encode($arg) if utf8::is_utf8($arg); - $arg =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go; + if(ref($arg)||'' eq 'ARRAY') { + push @encoded_args, [map { + my $encoded = encode_utf8 $_; + $encoded =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go; + $encoded; + } @$arg]; + } else { + push @encoded_args, do { + my $encoded = encode_utf8 $arg; + $encoded =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go; + $encoded; + } + } } - if ( blessed($path) ) { # action object - s|/|%2F|g for @args; + if ( $path->$_isa('Catalyst::Action') ) { # action object + s|/|%2F|g for @encoded_args; my $captures = [ map { s|/|%2F|g; $_; } - ( scalar @args && ref $args[0] eq 'ARRAY' - ? @{ shift(@args) } + ( scalar @encoded_args && ref $encoded_args[0] eq 'ARRAY' + ? @{ shift(@encoded_args) } : ()) ]; - foreach my $capture (@$captures) { - utf8::encode($capture) if utf8::is_utf8($capture); - $capture =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go; - } - my $action = $path; # ->uri_for( $action, \@captures_and_args, \%query_values? ) - if( !@args && $action->number_of_args ) { + if( !@encoded_args && $action->number_of_args ) { my $expanded_action = $c->dispatcher->expand_action( $action ); my $num_captures = $expanded_action->number_of_captures; - unshift @args, splice @$captures, $num_captures; + unshift @encoded_args, splice @$captures, $num_captures; } $path = $c->dispatcher->uri_for_action($action, $captures); @@ -1312,23 +1432,27 @@ sub uri_for { $path = '/' if $path eq ''; } - unshift(@args, $path); + unshift(@encoded_args, $path); unless (defined $path && $path =~ s!^/!!) { # in-place strip my $namespace = $c->namespace; if (defined $path) { # cheesy hack to handle path '../foo' - $namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{}; + $namespace =~ s{(?:^|/)[^/]+$}{} while $encoded_args[0] =~ s{^\.\./}{}; } - unshift(@args, $namespace || ''); + unshift(@encoded_args, $namespace || ''); } # join args with '/', or a blank string - my $args = join('/', grep { defined($_) } @args); + my $args = join('/', grep { defined($_) } @encoded_args); $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE $args =~ s!^/+!!; - my $base = $c->req->base; - my $class = ref($base); - $base =~ s{(?req->base; + $class = ref($base); + $base =~ s{(?{$_}; - s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go; + #s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go; ## Commented out because seems to lead to double encoding - JNAP s/ /+/g; my $key = $_; $val = '' unless defined $val; (map { my $param = "$_"; - utf8::encode( $param ) if utf8::is_utf8($param); + $param = encode_utf8($param); # using the URI::Escape pattern here so utf8 chars survive $param =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go; $param =~ s/ /+/g; + + $key = encode_utf8($key); + # using the URI::Escape pattern here so utf8 chars survive + $key =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go; + $key =~ s/ /+/g; + "${key}=$param"; } ( ref $val eq 'ARRAY' ? @$val : $val )); } @keys); } @@ -1529,18 +1659,18 @@ sub welcome_message { We do, however, provide you with a few starting points.

If you want to jump right into web development with Catalyst you might want to start with a tutorial.

-
perldoc Catalyst::Manual::Tutorial
+
perldoc Catalyst::Manual::Tutorial
 

Afterwards you can go on to check out a more complete look at our features.

-perldoc Catalyst::Manual::Intro
+perldoc Catalyst::Manual::Intro
 
 

What to do next?

Next it's time to write an actual application. Use the - helper scripts to generate controllers, - models, and - views; + helper scripts to generate controllers, + models, and + views; they can save you a lot of work.

script/${prefix}_create.pl --help

Also, be sure to check out the vast and growing @@ -1671,6 +1801,16 @@ sub execute { my $last = pop( @{ $c->stack } ); if ( my $error = $@ ) { + #rethow if this can be handled by middleware + if(blessed $error && ($error->can('as_psgi') || $error->can('code'))) { + foreach my $err (@{$c->error}) { + $c->log->error($err); + } + $c->clear_errors; + $c->log->_flush if $c->log->can('_flush'); + + $error->can('rethrow') ? $error->rethrow : croak $error; + } if ( blessed($error) and $error->isa('Catalyst::Exception::Detach') ) { $error->rethrow if $c->depth > 1; } @@ -1773,6 +1913,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') ) { @@ -1787,20 +1935,15 @@ sub finalize { $c->finalize_error; } - $c->finalize_headers; - - # HEAD request - if ( $c->request->method eq 'HEAD' ) { - $c->response->body(''); - } - + $c->finalize_encoding; + $c->finalize_headers unless $c->response->finalized_headers; $c->finalize_body; } $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" ); @@ -1827,11 +1970,31 @@ sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) } =head2 $c->finalize_error -Finalizes error. +Finalizes error. If there is only one error in L and it is an object that +does C or C we rethrow the error and presume it caught by middleware +up the ladder. Otherwise we return the debugging error page (in debug mode) or we +return the default error page (production mode). =cut -sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) } +sub finalize_error { + my $c = shift; + if($#{$c->error} > 0) { + $c->engine->finalize_error( $c, @_ ); + } else { + my ($error) = @{$c->error}; + if( + blessed $error && + ($error->can('as_psgi') || $error->can('code')) + ) { + # In the case where the error 'knows what it wants', becauses its PSGI + # aware, just rethow and let middleware catch it + $error->can('rethrow') ? $error->rethrow : croak $error; + } else { + $c->engine->finalize_error( $c, @_ ) + } + } +} =head2 $c->finalize_headers @@ -1851,58 +2014,60 @@ sub finalize_headers { if ( my $location = $response->redirect ) { $c->log->debug(qq/Redirecting to "$location"/) if $c->debug; $response->header( Location => $location ); - - if ( !$response->has_body ) { - # Add a default body if none is already present - $response->body(<<"EOF"); - - - - Moved - - -

This item has moved here.

- - -EOF - $response->content_type('text/html; charset=utf-8'); - } } - # 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') || ref( $response->body ) eq 'GLOB' ) - { - my $size = -s $response->body; - if ( $size ) { - $response->content_length( $size ); - } - else { - $c->log->warn('Serving filehandle without a content-length'); - } - } - else { - # everything should be bytes at this point, but just in case - $response->content_length( length( $response->body ) ); - } - } - - # Errors - if ( $response->status =~ /^(1\d\d|[23]04)$/ ) { - $response->headers->remove_header("Content-Length"); - $response->body(''); - } + # Remove incorrectly added body and content related meta data when returning + # an information response, or a response the is required to not include a body $c->finalize_cookies; - $c->engine->finalize_headers( $c, @_ ); + $c->response->finalize_headers(); # Done $response->finalized_headers(1); } +=head2 $c->finalize_encoding + +Make sure your headers and body are encoded properly IF you set an encoding. +See L. + +=cut + +sub finalize_encoding { + my $c = shift; + + my $body = $c->response->body; + + return unless defined($body); + + my $enc = $c->encoding; + + return unless $enc; + + my ($ct, $ct_enc) = $c->response->content_type; + + # Only touch 'text-like' contents + return unless $c->response->content_type =~ /^text|xml$|javascript$/; + + if ($ct_enc && $ct_enc =~ /charset=([^;]*)/) { + if (uc($1) ne uc($enc->mime_name)) { + $c->log->debug("Unicode::Encoding is set to encode in '" . + $enc->mime_name . + "', content type is '$1', not encoding "); + return; + } + } else { + $c->res->content_type($c->res->content_type . "; charset=" . $enc->mime_name); + } + + # Oh my, I wonder what filehandle responses and streams do... - jnap. + # Encode expects plain scalars (IV, NV or PV) and segfaults on ref's + if (ref(\$body) eq 'SCALAR') { + $c->response->body( $c->encoding->encode( $body, $c->_encode_check ) ); + }; +} + =head2 $c->finalize_output An alias for finalize_body. @@ -1962,8 +2127,11 @@ sub handle_request { my $c = $class->prepare(@arguments); $c->dispatch; $status = $c->finalize; - } - catch { + } catch { + #rethow if this can be handled by middleware + if(blessed $_ && ($_->can('as_psgi') || $_->can('code'))) { + $_->can('rethrow') ? $_->rethrow : croak $_; + } chomp(my $error = $_); $class->log->error(qq/Caught exception in engine "$error"/); }; @@ -1983,6 +2151,11 @@ etc.). =cut +has _uploadtmp => ( + is => 'ro', + predicate => '_has_uploadtmp', +); + sub prepare { my ( $class, @arguments ) = @_; @@ -1991,10 +2164,9 @@ sub prepare { # into the application. $class->context_class( ref $class || $class ) unless $class->context_class; - my $c = $class->context_class->new({}); + my $uploadtmp = $class->config->{uploadtmp}; + my $c = $class->context_class->new({ $uploadtmp ? (_uploadtmp => $uploadtmp) : ()}); - # For on-demand data - $c->request->_context($c); $c->response->_context($c); #surely this is not the most efficient way to do things... @@ -2012,8 +2184,8 @@ sub prepare { $c->prepare_request(@arguments); $c->prepare_connection; $c->prepare_query_parameters; - $c->prepare_headers; - $c->prepare_cookies; + $c->prepare_headers; # Just hooks, no longer needed - they just + $c->prepare_cookies; # cause the lazy attribute on req to build $c->prepare_path; # Prepare the body for reading, either by prepare_body @@ -2055,7 +2227,19 @@ Prepares action. See L. =cut -sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) } +sub prepare_action { + my $c = shift; + my $ret = $c->dispatcher->prepare_action( $c, @_); + + if($c->encoding) { + foreach (@{$c->req->arguments}, @{$c->req->captures}) { + $_ = $c->_handle_param_unicode_decoding($_); + } + } + + return $ret; +} + =head2 $c->prepare_body @@ -2106,24 +2290,26 @@ Prepares connection. sub prepare_connection { my $c = shift; - $c->engine->prepare_connection( $c, @_ ); + $c->request->prepare_connection($c); } =head2 $c->prepare_cookies -Prepares cookies. +Prepares cookies by ensuring that the attribute on the request +object has been built. =cut -sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) } +sub prepare_cookies { my $c = shift; $c->request->cookies } =head2 $c->prepare_headers -Prepares headers. +Prepares request headers by ensuring that the attribute on the request +object has been built. =cut -sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) } +sub prepare_headers { my $c = shift; $c->request->headers } =head2 $c->prepare_parameters @@ -2187,6 +2373,10 @@ sub log_request { $method ||= ''; $path = '/' unless length $path; $address ||= ''; + + $path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; + $path = decode_utf8($path); + $c->log->debug(qq/"$method" request for "$path" from "$address"/); $c->log_request_headers($request->headers); @@ -2371,8 +2561,38 @@ Prepares uploads. sub prepare_uploads { my $c = shift; - $c->engine->prepare_uploads( $c, @_ ); + + my $enc = $c->encoding; + return unless $enc; + + # Uggg we hook prepare uploads to do the encoding crap on post and query + # parameters! Cargo culted from old encoding plugin. Sorry -jnap + for my $key (qw/ parameters query_parameters body_parameters /) { + for my $value ( values %{ $c->request->{$key} } ) { + # N.B. Check if already a character string and if so do not try to double decode. + # http://www.mail-archive.com/catalyst@lists.scsys.co.uk/msg02350.html + # this avoids exception if we have already decoded content, and is _not_ the + # same as not encoding on output which is bad news (as it does the wrong thing + # for latin1 chars for example).. + $value = $c->_handle_unicode_decoding($value); + } + } + for my $value ( values %{ $c->request->uploads } ) { + # skip if it fails for uploads, as we don't usually want uploads touched + # in any way + for my $inner_value ( ref($value) eq 'ARRAY' ? @{$value} : $value ) { + $inner_value->{filename} = try { + $enc->decode( $inner_value->{filename}, $c->_encode_check ) + } catch { + $c->handle_unicode_encoding_exception({ + param_value => $inner_value->{filename}, + error_msg => $_, + encoding_step => 'uploads', + }); + }; + } + } } =head2 $c->prepare_write @@ -2406,7 +2626,7 @@ $c->request. You must handle all body parsing yourself. =cut -sub read { my $c = shift; return $c->engine->read( $c, @_ ) } +sub read { my $c = shift; return $c->request->read( @_ ) } =head2 $c->run @@ -2416,11 +2636,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 = find_meta($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. @@ -2502,18 +2746,15 @@ sub locate_components { my $class = shift; my $config = shift; - my @paths = qw( ::Controller ::C ::Model ::M ::View ::V ); + my @paths = qw( ::M ::Model ::V ::View ::C ::Controller ); my $extra = delete $config->{ search_extra } || []; - push @paths, @$extra; - - my $locator = Module::Pluggable::Object->new( - search_path => [ map { s/^(?=::)/$class/; $_; } @paths ], - %$config - ); + unshift @paths, @$extra; - # XXX think about ditching this sort entirely - my @comps = sort { length $a <=> length $b } $locator->plugins; + my @comps = map { sort { length($a) <=> length($b) } Module::Pluggable::Object->new( + search_path => [ map { s/^(?=::)/$class/; $_; } ($_) ], + %$config + )->plugins } @paths; return @comps; } @@ -2591,7 +2832,7 @@ sub setup_dispatcher { $dispatcher = $class->dispatcher_class; } - Class::MOP::load_class($dispatcher); + load_class($dispatcher); # dispatcher instance $class->dispatcher( $dispatcher->new ); @@ -2641,7 +2882,7 @@ sub setup_engine { # Don't really setup_engine -- see _setup_psgi_app for explanation. return if $class->loading_psgi_file; - Class::MOP::load_class($engine); + load_class($engine); if ($ENV{MOD_PERL}) { my $apache = $class->engine_loader->auto; @@ -2665,6 +2906,11 @@ sub setup_engine { return; } +## This exists just to supply a prebuild psgi app for mod_perl and for the +## build in server support (back compat support for pre psgi port behavior). +## This is so that we don't build a new psgi app for each request when using +## the mod_perl handler or the built in servers (http and fcgi, etc). + sub _finalized_psgi_app { my ($app) = @_; @@ -2676,6 +2922,12 @@ sub _finalized_psgi_app { return $app->_psgi_app; } +## Look for a psgi file like 'myapp_web.psgi' (if the app is MyApp::Web) in the +## home directory and load that and return it (just assume it is doing the +## right thing :) ). If that does not exist, call $app->psgi_app, wrap that +## in default_middleware and return it ( this is for backward compatibility +## with pre psgi port behavior ). + sub _setup_psgi_app { my ($app) = @_; @@ -2760,10 +3012,22 @@ 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; } -=head2 $c->psgi_app +=head2 App->psgi_app + +=head2 App->to_app Returns a PSGI application code reference for the catalyst application C<$c>. This is the bare application without any middlewares @@ -2774,9 +3038,12 @@ reference of your Catalyst application for use in F<.psgi> files. =cut +*to_app = \&psgi_app; + sub psgi_app { my ($app) = @_; - return $app->engine->build_psgi_app($app); + my $psgi = $app->engine->build_psgi_app($app); + return $app->Catalyst::Utils::apply_registered_middleware($psgi); } =head2 $c->setup_home @@ -2801,6 +3068,80 @@ sub setup_home { } } +=head2 $c->setup_encoding + +Sets up the input/output encoding. See L + +=cut + +sub setup_encoding { + my $c = shift; + my $enc = delete $c->config->{encoding}; + $c->encoding( $enc ) if defined $enc; +} + +=head2 handle_unicode_encoding_exception + +Hook to let you customize how encoding errors are handled. By default +we just throw an exception. Receives a hashref of debug information. +Example: + + $c->handle_unicode_encoding_exception({ + param_value => $value, + error_msg => $_, + encoding_step => 'params', + }); + +=cut + +sub handle_unicode_encoding_exception { + my ( $self, $exception_ctx ) = @_; + die $exception_ctx->{error_msg}; +} + +# Some unicode helpers cargo culted from the old plugin. These could likely +# be neater. + +sub _handle_unicode_decoding { + my ( $self, $value ) = @_; + + return unless defined $value; + + ## I think this mess is to support the old nested + if ( ref $value eq 'ARRAY' ) { + foreach ( @$value ) { + $_ = $self->_handle_unicode_decoding($_); + } + return $value; + } + elsif ( ref $value eq 'HASH' ) { + foreach ( values %$value ) { + $_ = $self->_handle_unicode_decoding($_); + } + return $value; + } + else { + return $self->_handle_param_unicode_decoding($value); + } +} + +sub _handle_param_unicode_decoding { + my ( $self, $value ) = @_; + return unless defined $value; # not in love with just ignoring undefs - jnap + + my $enc = $self->encoding; + return try { + $enc->decode( $value, $self->_encode_check ); + } + catch { + $self->handle_unicode_encoding_exception({ + param_value => $value, + error_msg => $_, + encoding_step => 'params', + }); + }; +} + =head2 $c->setup_log Sets up log by instantiating a L object and @@ -2895,21 +3236,42 @@ the plugin name does not begin with C. my ( $proto, $plugin, $instant ) = @_; my $class = ref $proto || $proto; - Class::MOP::load_class( $plugin ); + 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() } + 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 { @@ -2922,7 +3284,7 @@ the plugin name does not begin with C. } @{ $plugins }; for my $plugin ( reverse @plugins ) { - Class::MOP::load_class($plugin->[0], $plugin->[1]); + load_class($plugin->[0], $plugin->[1]); my $meta = find_meta($plugin->[0]); next if $meta && $meta->isa('Moose::Meta::Role'); @@ -2939,6 +3301,161 @@ the plugin name does not begin with C. $class => @roles ) if @roles; } +} + +=head2 registered_middlewares + +Read only accessor that returns an array of all the middleware in the order +that they were added (which is the REVERSE of the order they will be applied). + +The values returned will be either instances of L or of a +compatible interface, or a coderef, which is assumed to be inlined middleware + +=head2 setup_middleware (?@middleware) + +Read configuration information stored in configuration key C or +from passed @args. + +See under L information regarding C and how +to use it to enable L + +This method is automatically called during 'setup' of your application, so +you really don't need to invoke it. However you may do so if you find the idea +of loading middleware via configuration weird :). For example: + + package MyApp; + + use Catalyst; + + __PACKAGE__->setup_middleware('Head'); + __PACKAGE__->setup; + +When we read middleware definitions from configuration, we reverse the list +which sounds odd but is likely how you expect it to work if you have prior +experience with L or if you previously used the plugin +L (which is now considered deprecated) + +So basically your middleware handles an incoming request from the first +registered middleware, down and handles the response from the last middleware +up. + +=cut + +sub registered_middlewares { + my $class = shift; + if(my $middleware = $class->_psgi_middleware) { + return ( + Catalyst::Middleware::Stash->new, + Plack::Middleware::HTTPExceptions->new, + Plack::Middleware::RemoveRedundantBody->new, + Plack::Middleware::FixMissingBodyInRedirect->new, + Plack::Middleware::ContentLength->new, + Plack::Middleware::MethodOverride->new, + Plack::Middleware::Head->new, + @$middleware); + } else { + die "You cannot call ->registered_middlewares until middleware has been setup"; + } +} + +sub setup_middleware { + my $class = shift; + my @middleware_definitions = @_ ? + reverse(@_) : reverse(@{$class->config->{'psgi_middleware'}||[]}); + + my @middleware = (); + while(my $next = shift(@middleware_definitions)) { + if(ref $next) { + if(Scalar::Util::blessed $next && $next->can('wrap')) { + push @middleware, $next; + } elsif(ref $next eq 'CODE') { + push @middleware, $next; + } elsif(ref $next eq 'HASH') { + my $namespace = shift @middleware_definitions; + my $mw = $class->Catalyst::Utils::build_middleware($namespace, %$next); + push @middleware, $mw; + } else { + die "I can't handle middleware definition ${\ref $next}"; + } + } else { + my $mw = $class->Catalyst::Utils::build_middleware($next); + push @middleware, $mw; + } + } + + my @existing = @{$class->_psgi_middleware || []}; + $class->_psgi_middleware([@middleware,@existing,]); +} + +=head2 registered_data_handlers + +A read only copy of registered Data Handlers returned as a Hash, where each key +is a content type and each value is a subref that attempts to decode that content +type. + +=head2 setup_data_handlers (?@data_handler) + +Read configuration information stored in configuration key C or +from passed @args. + +See under L information regarding C. + +This method is automatically called during 'setup' of your application, so +you really don't need to invoke it. + +=head2 default_data_handlers + +Default Data Handlers that come bundled with L. Currently there are +only two default data handlers, for 'application/json' and an alternative to +'application/x-www-form-urlencoded' which supposed nested form parameters via +L or via L IF you've installed it. + +The 'application/json' data handler is used to parse incoming JSON into a Perl +data structure. It used either L or L, depending on which +is installed. This allows you to fail back to L, which is a Pure Perl +JSON decoder, and has the smallest dependency impact. + +Because we don't wish to add more dependencies to L, if you wish to +use this new feature we recommend installing L or L in +order to get the best performance. You should add either to your dependency +list (Makefile.PL, dist.ini, cpanfile, etc.) + +=cut + +sub registered_data_handlers { + my $class = shift; + if(my $data_handlers = $class->_data_handlers) { + return %$data_handlers; + } else { + $class->setup_data_handlers; + return $class->registered_data_handlers; + } +} + +sub setup_data_handlers { + my ($class, %data_handler_callbacks) = @_; + %data_handler_callbacks = ( + %{$class->default_data_handlers}, + %{$class->config->{'data_handlers'}||+{}}, + %data_handler_callbacks); + + $class->_data_handlers(\%data_handler_callbacks); +} + +sub default_data_handlers { + my ($class) = @_; + return +{ + 'application/x-www-form-urlencoded' => sub { + my ($fh, $req) = @_; + my $params = $req->_use_hash_multivalue ? $req->body_parameters->mixed : $req->body_parameters; + Class::Load::load_first_existing_class('CGI::Struct::XS', 'CGI::Struct') + ->can('build_cgi_struct')->($params); + }, + 'application/json' => sub { + Class::Load::load_first_existing_class('JSON::MaybeXS', 'JSON') + ->can('decode_json')->(do { local $/; $_->getline }); + }, + }; } =head2 $c->stack @@ -2984,10 +3501,10 @@ your output data, if known. sub write { my $c = shift; - # Finalize headers if someone manually writes output + # Finalize headers if someone manually writes output (for compat) $c->finalize_headers; - return $c->engine->write( $c, @_ ); + return $c->response->write( @_ ); } =head2 version @@ -3101,14 +3618,85 @@ 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), the resolution of C<< $c->request->base >> will be incorrect. -=back +=back =item * C - See L. +=item * + +C - See L + +=item * + +C + +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. + +=item * + +C + +In L the methods C, C +and C return a hashref where values might be scalar or an arrayref +depending on the incoming data. In many cases this can be undesirable as it +leads one to writing defensive code like the following: + + my ($val) = ref($c->req->parameters->{a}) ? + @{$c->req->parameters->{a}} : + $c->req->parameters->{a}; + +Setting this configuration item to true will make L populate the +attributes underlying these methods with an instance of L +which is used by L and others to solve this very issue. You +may prefer this behavior to the default, if so enable this option (be warned +if you enable it in a legacy application we are not sure if it is completely +backwardly compatible). + +=item * + +C - See L. + +=item * + +C - See L. + =back +=head1 EXCEPTIONS + +Generally when you throw an exception inside an Action (or somewhere in +your stack, such as in a model that an Action is calling) that exception +is caught by Catalyst and unless you either catch it yourself (via eval +or something like L or by reviewing the L stack, it +will eventually reach L and return either the debugging +error stack page, or the default error page. However, if your exception +can be caught by L, L will +instead rethrow it so that it can be handled by that middleware (which +is part of the default middleware). For example this would allow + + use HTTP::Throwable::Factory 'http_throw'; + + sub throws_exception :Local { + my ($self, $c) = @_; + + http_throw(SeeOther => { location => + $c->uri_for($self->action_for('redirect')) }); + + } + =head1 INTERNAL ACTIONS Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>, @@ -3198,6 +3786,235 @@ 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, are not thread-safe. +=head1 DATA HANDLERS + +The L object uses L to populate 'classic' HTML +form parameters and URL search query fields. However it has become common +for various alternative content types to be PUT or POSTed to your controllers +and actions. People working on RESTful APIs, or using AJAX often use JSON, +XML and other content types when communicating with an application server. In +order to better support this use case, L defines a global configuration +option, C, which lets you associate a content type with a coderef +that parses that content type into something Perl can readily access. + + package MyApp::Web; + + use Catalyst; + use JSON::Maybe; + + __PACKAGE__->config( + data_handlers => { + 'application/json' => sub { local $/; decode_json $_->getline }, + }, + ## Any other configuration. + ); + + __PACKAGE__->setup; + +By default L comes with a generic JSON data handler similar to the +example given above, which uses L to provide either L +(a pure Perl, dependency free JSON parser) or L if you have +it installed (if you want the faster XS parser, add it to you project Makefile.PL +or dist.ini, cpanfile, etc.) + +The C configuration is a hashref whose keys are HTTP Content-Types +(matched against the incoming request type using a regexp such as to be case +insensitive) and whose values are coderefs that receive a localized version of +C<$_> which is a filehandle object pointing to received body. + +This feature is considered an early access release and we reserve the right +to alter the interface in order to provide a performant and secure solution to +alternative request body content. Your reports welcomed! + +=head1 PSGI MIDDLEWARE + +You can define middleware, defined as L or a compatible +interface in configuration. Your middleware definitions are in the form of an +arrayref under the configuration key C. Here's an example +with details to follow: + + package MyApp::Web; + + use Catalyst; + use Plack::Middleware::StackTrace; + + my $stacktrace_middleware = Plack::Middleware::StackTrace->new; + + __PACKAGE__->config( + 'psgi_middleware', [ + 'Debug', + '+MyApp::Custom', + $stacktrace_middleware, + 'Session' => {store => 'File'}, + sub { + my $app = shift; + return sub { + my $env = shift; + $env->{myapp.customkey} = 'helloworld'; + $app->($env); + }, + }, + ], + ); + + __PACKAGE__->setup; + +So the general form is: + + __PACKAGE__->config(psgi_middleware => \@middleware_definitions); + +Where C<@middleware> is one or more of the following, applied in the REVERSE of +the order listed (to make it function similarly to L: + +Alternatively, you may also define middleware by calling the L +package method: + + package MyApp::Web; + + use Catalyst; + + __PACKAGE__->setup_middleware( \@middleware_definitions); + __PACKAGE__->setup; + +In the case where you do both (use 'setup_middleware' and configuration) the +package call to setup_middleware will be applied earlier (in other words its +middleware will wrap closer to the application). Keep this in mind since in +some cases the order of middleware is important. + +The two approaches are not exclusive. + +=over 4 + +=item Middleware Object + +An already initialized object that conforms to the L +specification: + + my $stacktrace_middleware = Plack::Middleware::StackTrace->new; + + __PACKAGE__->config( + 'psgi_middleware', [ + $stacktrace_middleware, + ]); + + +=item coderef + +A coderef that is an inlined middleware: + + __PACKAGE__->config( + 'psgi_middleware', [ + sub { + my $app = shift; + return sub { + my $env = shift; + if($env->{PATH_INFO} =~m/forced/) { + Plack::App::File + ->new(file=>TestApp->path_to(qw/share static forced.txt/)) + ->call($env); + } else { + return $app->($env); + } + }, + }, + ]); + + + +=item a scalar + +We assume the scalar refers to a namespace after normalizing it using the +following rules: + +(1) If the scalar is prefixed with a "+" (as in C<+MyApp::Foo>) then the full string +is assumed to be 'as is', and we just install and use the middleware. + +(2) If the scalar begins with "Plack::Middleware" or your application namespace +(the package name of your Catalyst application subclass), we also assume then +that it is a full namespace, and use it. + +(3) Lastly, we then assume that the scalar is a partial namespace, and attempt to +resolve it first by looking for it under your application namespace (for example +if you application is "MyApp::Web" and the scalar is "MyMiddleware", we'd look +under "MyApp::Web::Middleware::MyMiddleware") and if we don't find it there, we +will then look under the regular L namespace (i.e. for the +previous we'd try "Plack::Middleware::MyMiddleware"). We look under your application +namespace first to let you 'override' common L locally, should +you find that a good idea. + +Examples: + + package MyApp::Web; + + __PACKAGE__->config( + 'psgi_middleware', [ + 'Debug', ## MyAppWeb::Middleware::Debug->wrap or Plack::Middleware::Debug->wrap + 'Plack::Middleware::Stacktrace', ## Plack::Middleware::Stacktrace->wrap + '+MyApp::Custom', ## MyApp::Custom->wrap + ], + ); + +=item a scalar followed by a hashref + +Just like the previous, except the following C is used as arguments +to initialize the middleware object. + + __PACKAGE__->config( + 'psgi_middleware', [ + 'Session' => {store => 'File'}, + ]); + +=back + +Please see L for more on middleware. + +=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 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. + +=item encoding_step + +What type of data was being decoded. Valid values are (currently) +C - for request parameters / arguments / captures +and C - for request upload filenames. + +=back + +=back + =head1 SUPPORT IRC: @@ -3235,8 +4052,6 @@ Wiki: =head2 L - The test suite. -=begin stopwords - =head1 PROJECT FOUNDER sri: Sebastian Riedel @@ -3327,6 +4142,8 @@ marcus: Marcus Ramberg miyagawa: Tatsuhiko Miyagawa +mgrimes: Mark Grimes + mst: Matt S. Trout mugwump: Sam Vilain @@ -3365,13 +4182,15 @@ t0m: Tomas Doran Ulf Edvinsson +vanstyn: Henry Van Styn + Viljo Marrandi C Will Hawes C willert: Sebastian Willert -wreis: Wallace Reis +wreis: Wallace Reis Yuval Kogman, C @@ -3379,11 +4198,11 @@ rainboxx: Matthias Dietrich, C dd070: Dhaval Dhanani -=end stopwords +Upasana =head1 COPYRIGHT -Copyright (c) 2005, the above named PROJECT FOUNDER and CONTRIBUTORS. +Copyright (c) 2005-2014, the above named PROJECT FOUNDER and CONTRIBUTORS. =head1 LICENSE