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;
+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;
+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');
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;
}
lazy => 1,
);
sub _build_response_constructor_args {
- my $self = shift;
- { _log => $self->log };
+ return +{
+ _log => $_[0]->log,
+ encoding => $_[0]->encoding,
+ };
}
has namespace => (is => 'rw');
__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 _psgi_middleware/;
+ 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.90042';
+our $VERSION = '5.90079_001';
+$VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
sub import {
my ( $class, @arguments ) = @_;
=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<process()> 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,
# 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<Catalyst::Middleware::Stash>. Since it's part of the C<$env> items in
+the stash can be accessed in sub applications mounted under your main
+L<Catalyst> application. For example if you delegate the response of an
+action to another L<Catalyst> 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
$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(@_);
Your log class should implement the methods described in
L<Catalyst::Log>.
+=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
$class->setup_log( delete $flags->{log} );
$class->setup_plugins( delete $flags->{plugins} );
- $class->setup_middleware();
+
+ $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");
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;
$class->log->debug( "Loaded plugins:\n" . $t->draw . "\n" );
}
- my @middleware = map { ref $_ eq 'CODE' ? "Inline Coderef" : (ref($_) .' '. $_->VERSION || '') }
- $class->registered_middlewares;
+ 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;
$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};
? $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 } ) {
}
$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
# Path to a static resource
$c->uri_for('/static/images/logo.png');
+In general the scheme of the generated URI object will follow the incoming request
+however if your targeted action or action chain has the Scheme attribute it will
+use that instead.
+
=cut
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;
+ }
+ }
}
+ my $target_action = $path->$_isa('Catalyst::Action') ? $path : undef;
if ( $path->$_isa('Catalyst::Action') ) { # action object
- s|/|%2F|g for @args;
+ 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);
$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, $class) = ('/', 'URI::_generic');
if(blessed($c)) {
$base = $c->req->base;
- $class = ref($base);
+ if($target_action) {
+ $target_action = $c->dispatcher->expand_action($target_action);
+ if(my $s = $target_action->scheme) {
+ $s = lc($s);
+ $class = "URI::$s";
+ $base->scheme($s);
+ } else {
+ $class = ref($base);
+ }
+ } else {
+ $class = ref($base);
+ }
+
$base =~ s{(?<!/)$}{/};
}
# somewhat lifted from URI::_query's query_form
$query = '?'.join('&', map {
my $val = $params->{$_};
- 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);
}
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') &&
+ $error->code =~m/^[1-5][0-9][0-9]$/
+ )
+ )
+ ) {
+ 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;
}
# Support skipping finalize for psgix.io style 'jailbreak'. Used to support
# stuff like cometd and websockets
- if($c->request->has_io_fh) {
+ if($c->request->_has_io_fh) {
$c->log_response;
return;
}
$c->finalize_error;
}
+ $c->finalize_encoding;
$c->finalize_headers unless $c->response->finalized_headers;
-
- # HEAD request
- if ( $c->request->method eq 'HEAD' ) {
- $c->response->body('');
- }
-
$c->finalize_body;
}
=head2 $c->finalize_error
-Finalizes error.
+Finalizes error. If there is only one error in L</error> and it is an object that
+does C<as_psgi> or C<code> 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
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
- 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">
- <head>
- <title>Moved</title>
- </head>
- <body>
- <p>This item has moved <a href="$encoded_location">here</a>.</p>
- </body>
-</html>
-EOF
- $response->content_type('text/html; charset=utf-8');
- }
}
- # Content-Length
- if ( defined $response->body && length $response->body && !$response->content_length ) {
+ # 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
- # 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');
+ $c->finalize_cookies;
+
+ $c->response->finalize_headers();
+
+ if(my $enc = $c->encoding) {
+ my ($ct, $ct_enc) = $c->response->content_type;
+
+ # Only touch 'text-like' contents
+ if($c->response->content_type =~ /^text|xml$|javascript$/) {
+ if ($ct_enc && $ct_enc =~ /charset=([^;]*)/) {
+ if (uc($1) ne uc($enc->mime_name)) {
+ $c->log->debug("Catalyst encoding config is set to encode in '" .
+ $enc->mime_name .
+ "', content type is '$1', not encoding ");
}
- }
- else {
- # everything should be bytes at this point, but just in case
- $response->content_length( length( $response->body ) );
+ } else {
+ $c->res->content_type($c->res->content_type . "; charset=" . $enc->mime_name);
+ }
}
}
- # Errors
- if ( $response->status =~ /^(1\d\d|[23]04)$/ ) {
- $response->headers->remove_header("Content-Length");
- $response->body('');
- }
+ # Done
+ $response->finalized_headers(1);
+}
- $c->finalize_cookies;
+=head2 $c->finalize_encoding
- $c->response->finalize_headers();
+Make sure your body is encoded properly IF you set an encoding. By
+default the encoding is UTF-8 but you can disable it by explictly setting the
+encoding configuration value to undef.
- # Done
- $response->finalized_headers(1);
+See L</ENCODING>.
+
+=cut
+
+sub finalize_encoding {
+ my $c = shift;
+
+ my $body = $c->response->body;
+
+ return unless defined($body);
+
+ my $enc = $c->encoding;
+
+ return unless $enc;
+
+ # Only touch 'text-like' contents
+ if($c->response->content_type =~ /^text|xml$|javascript$/) {
+ if (ref(\$body) eq 'SCALAR') {
+ $c->response->body( $c->encoding->encode( $body, $c->_encode_check ) );
+ }
+ }
}
=head2 $c->finalize_output
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') &&
+ $_->code =~m/^[1-5][0-9][0-9]$/
+ )
+ )
+ ) {
+ $_->can('rethrow') ? $_->rethrow : croak $_;
+ }
chomp(my $error = $_);
$class->log->error(qq/Caught exception in engine "$error"/);
};
=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
sub prepare_body_parameters {
my $c = shift;
- $c->engine->prepare_body_parameters( $c, @_ );
+ $c->request->prepare_body_parameters( $c, @_ );
}
=head2 $c->prepare_connection
sub prepare_connection {
my $c = shift;
- # XXX - This is called on the engine (not the request) to maintain
- # Engine::PSGI back compat.
- $c->engine->prepare_connection($c);
+ $c->request->prepare_connection($c);
}
=head2 $c->prepare_cookies
$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);
sub prepare_uploads {
my $c = shift;
-
$c->engine->prepare_uploads( $c, @_ );
}
sub _make_immutable_if_needed {
my $class = shift;
- my $meta = Class::MOP::get_metaclass_by_name($class);
+ my $meta = find_meta($class);
my $isa_ca = $class->isa('Class::Accessor::Fast') || $class->isa('Class::Accessor');
if (
$meta->is_immutable
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;
}
$dispatcher = $class->dispatcher_class;
}
- Class::MOP::load_class($dispatcher);
+ load_class($dispatcher);
# dispatcher instance
$class->dispatcher( $dispatcher->new );
# 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;
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
=cut
+*to_app = \&psgi_app;
+
sub psgi_app {
my ($app) = @_;
my $psgi = $app->engine->build_psgi_app($app);
- return $app->apply_registered_middleware($psgi);
+ return $app->Catalyst::Utils::apply_registered_middleware($psgi);
}
=head2 $c->setup_home
}
}
+=head2 $c->setup_encoding
+
+Sets up the input/output encoding. See L<ENCODING>
+
+=cut
+
+sub setup_encoding {
+ my $c = shift;
+ if( exists($c->config->{encoding}) && !defined($c->config->{encoding}) ) {
+ # Ok, so the user has explicitly said "I don't want encoding..."
+ return;
+ } else {
+ my $enc = defined($c->config->{encoding}) ?
+ delete $c->config->{encoding} : 'UTF-8'; # not sure why we delete it... (JNAP)
+ $c->encoding($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 (keys %$value) {
+ my $encoded_key = $self->_handle_param_unicode_decoding($_);
+ $value->{$encoded_key} = $self->_handle_unicode_decoding($value->{$_});
+
+ # If the key was encoded we now have two (the original and current so
+ # delete the original.
+ delete $value->{$_} if $_ ne $encoded_key;
+ }
+ 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<Catalyst::Log|Catalyst::Log> object and
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' );
my $plugin_meta = Moose::Meta::Class->create($plugin);
return $class;
}
- sub _default_plugins { return qw(Unicode::Encoding) }
+ sub _default_plugins { return qw() }
sub setup_plugins {
my ( $class, $plugins ) = @_;
} @{ $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');
}
}
-=head2 setup_middleware (?@middleware)
-
-Read configuration information stored in configuration key 'psgi_middleware'
-and invoke L</register_middleware> for each middleware prototype found. See
-under L</CONFIGURATION> information regarding L</psgi_middleware> and how to
-use it to enable L<Plack::Middleware>
-
-This method is automatically called during 'setup' of your application, so
-you really don't need to invoke it.
-
-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<Plack::Builder> or if you previously used the plugin
-L<Catalyst::Plugin::EnableMiddleware> (which is now considered deprecated)
+=head2 registered_middlewares
-You can pass middleware definitions to this as well, from the application
-class if you like.
+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).
-=head2 register_middleware (@args)
+The values returned will be either instances of L<Plack::Middleware> or of a
+compatible interface, or a coderef, which is assumed to be inlined middleware
-Given @args that represent the definition of some L<Plack::Middleware> or
-middleware with a compatible interface, register it with your L<Catalyst>
-application.
+=head2 setup_middleware (?@middleware)
-This is called by L</setup_middleware>. the behavior of invoking it yourself
-at run time is currently undefined, and anything that works or doesn't work
-as a result of doing so is considered a side effect subject to change.
+Read configuration information stored in configuration key C<psgi_middleware> or
+from passed @args.
-=head2 _build_middleware (@args)
+See under L</CONFIGURATION> information regarding C<psgi_middleware> and how
+to use it to enable L<Plack::Middleware>
-Internal application that converts a single middleware definition (see
-L</psgi_middleware>) into an actual instance of middleware.
+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:
-=head2 registered_middlewares
+ package MyApp;
-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).
+ use Catalyst;
-The values returned will be either instances of L<Plack::Middleware> or of a
-compatible interface, or a coderef, which is assumed to be inlined middleware
+ __PACKAGE__->setup_middleware('Head');
+ __PACKAGE__->setup;
-=head2 apply_registered_middleware ($psgi)
+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<Plack::Builder> or if you previously used the plugin
+L<Catalyst::Plugin::EnableMiddleware> (which is now considered deprecated)
-Given a $psgi reference, wrap all the L<registered_middlewares> around it and
-return the wrapped version.
+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 { @{shift->_psgi_middleware || []} }
+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, @middleware_definitions) = @_;
- push @middleware_definitions, reverse(
- @{$class->config->{'psgi_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')) {
- $class->register_middleware($next);
+ push @middleware, $next;
} elsif(ref $next eq 'CODE') {
- $class->register_middleware($next);
+ push @middleware, $next;
} elsif(ref $next eq 'HASH') {
my $namespace = shift @middleware_definitions;
- my $mw = $class->_build_middleware($namespace, %$next);
- $class->register_middleware($mw);
+ 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->_build_middleware($next);
- $class->register_middleware($mw);
+ my $mw = $class->Catalyst::Utils::build_middleware($next);
+ push @middleware, $mw;
}
}
+
+ my @existing = @{$class->_psgi_middleware || []};
+ $class->_psgi_middleware([@middleware,@existing,]);
}
-sub register_middleware {
- my ($class, @middleware) = @_;
- if($class->_psgi_middleware) {
- push @{$class->_psgi_middleware}, @middleware;
- } else {
- $class->_psgi_middleware(\@middleware);
- }
-}
-
-sub _build_middleware {
- my ($class, $namespace, @init_args) = @_;
-
- if(
- $namespace =~s/^\+// ||
- $namespace =~/^Plack::Middleware/ ||
- $namespace =~/^$class/
- ) { ## the string is a full namespace
- return Class::Load::try_load_class($namespace) ?
- $namespace->new(@init_args) :
- die "Can't load class $namespace";
- } else { ## the string is a partial namespace
- if(Class::Load::try_load_class("Plack::Middleware::$namespace")) { ## Act like Plack::Builder
- return "Plack::Middleware::$namespace"->new(@init_args);
- } elsif(Class::Load::try_load_class("$class::$namespace")) { ## Load Middleware from Project namespace
- return "$class::$namespace"->new(@init_args);
- }
+=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<data_handlers> or
+from passed @args.
+
+See under L</CONFIGURATION> information regarding C<data_handlers>.
+
+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<Catalyst>. 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<CGI::Struct> or via L<CGI::Struct::XS> 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<JSON::MaybeXS> or L<JSON>, depending on which
+is installed. This allows you to fail back to L<JSON:PP>, which is a Pure Perl
+JSON decoder, and has the smallest dependency impact.
+
+Because we don't wish to add more dependencies to L<Catalyst>, if you wish to
+use this new feature we recommend installing L<JSON> or L<JSON::MaybeXS> 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);
- return; ## be sure we can count on a proper return when valid
+ $class->_data_handlers(\%data_handler_callbacks);
}
-sub apply_registered_middleware {
- my ($class, $psgi) = @_;
- my $new_psgi = $psgi;
- foreach my $middleware ($class->registered_middlewares) {
- $new_psgi = Scalar::Util::blessed $middleware ?
- $middleware->wrap($new_psgi) :
- $middleware->($new_psgi);
- }
- return $new_psgi;
+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
C<encoding> - See L</ENCODING>
+This now defaults to 'UTF-8'. You my turn it off by setting this configuration
+value to undef.
+
=item *
C<abort_chain_on_error_fix>
=item *
+C<use_hash_multivalue_in_request>
+
+In L<Catalyst::Request> the methods C<query_parameters>, C<body_parametes>
+and C<parameters> 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<Catalyst> populate the
+attributes underlying these methods with an instance of L<Hash::MultiValue>
+which is used by L<Plack::Request> 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<psgi_middleware> - See L<PSGI MIDDLEWARE>.
+=item *
+
+C<data_handlers> - See L<DATA HANDLERS>.
+
=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<Try::Tiny> or by reviewing the L</error> stack, it
+will eventually reach L</finalize_errors> and return either the debugging
+error stack page, or the default error page. However, if your exception
+can be caught by L<Plack::Middleware::HTTPExceptions>, L<Catalyst> 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>,
modules you are using must also be thread-safe. Some modules, most notably
L<DBD::SQLite>, are not thread-safe.
+=head1 DATA HANDLERS
+
+The L<Catalyst::Request> object uses L<HTTP::Body> 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<Catalyst> defines a global configuration
+option, C<data_handlers>, 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<Catalyst> comes with a generic JSON data handler similar to the
+example given above, which uses L<JSON::Maybe> to provide either L<JSON::PP>
+(a pure Perl, dependency free JSON parser) or L<Cpanel::JSON::XS> 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<data_handlers> 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<Plack::Middleware> or a compatible
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<Plack::Builder>:
+
+Alternatively, you may also define middleware by calling the L</setup_middleware>
+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
On request, decodes all params from encoding into a sequence of
logical characters. On response, encodes body into encoding.
+By default encoding is now 'UTF-8'. You may turn it off by setting
+the encoding configuration to undef.
+
=head2 Methods
=over 4
Ulf Edvinsson
+vanstyn: Henry Van Styn <vanstyn@cpan.org>
+
Viljo Marrandi C<vilts@yahoo.com>
Will Hawes C<info@whawes.co.uk>
dd070: Dhaval Dhanani <dhaval070@gmail.com>
+Upasana <me@upasana.me>
+
=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
projects / catagits/Catalyst-Runtime.git / blobdiff