use Catalyst::Middleware::Stash;
use Plack::Util;
use Class::Load 'load_class';
+use Encode 2.21 ();
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');
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
- _data_handlers/;
+ _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.90069_001';
+our $VERSION = '5.90078';
sub import {
my ( $class, @arguments ) = @_;
# stash is automatically passed to the view for use in a template
$c->forward( 'MyApp::View::TT' );
-
-
-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};
- }
- }
-
- return $stash;
-};
-
=cut
sub stash {
my $c = shift;
- my $stash = Catalyst::Middleware::Stash->get($c->req->env);
- 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};
- }
- }
- return $stash;
+ return Catalyst::Middleware::Stash::get_stash($c->req->env)->(@_);
}
=head2 $c->error
$c->error('Something bad happened');
+Calling this will always return an arrayref (if there are no errors it
+will be an empty arrayref.
+
=cut
sub error {
sub has_errors { scalar(@{shift->error}) ? 1:0 }
+=head2 $c->last_error
+
+Returns the most recent error in the stack (the one most recently added...)
+or nothing if there are no errors.
+
+=cut
+
+sub last_error { my ($err, @errs) = @{shift->error}; return $err }
+
+=head2 shift_errors
+
+shifts the most recently added error off the error stack and returns if. Returns
+nothing if there are nomore errors.
+
+=cut
+
+sub shift_errors {
+ my ($self) = @_;
+ my ($err, @errors) = @{$self->error};
+ $self->{error} = \@errors;
+ return $err;
+}
+
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 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
if ( my $error = $@ ) {
#rethow if this can be handled by middleware
- if(blessed $error && ($error->can('as_psgi') || $error->can('code'))) {
+ if ( $c->_handle_http_exception($error) ) {
foreach my $err (@{$c->error}) {
$c->log->error($err);
}
# 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;
$c->finalize_error;
}
+ $c->finalize_encoding;
$c->finalize_headers unless $c->response->finalized_headers;
-
$c->finalize_body;
}
$c->engine->finalize_error( $c, @_ );
} else {
my ($error) = @{$c->error};
- if(
- blessed $error &&
- ($error->can('as_psgi') || $error->can('code'))
- ) {
+ if ( $c->_handle_http_exception($error) ) {
# 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;
$response->finalized_headers(1);
}
+=head2 $c->finalize_encoding
+
+Make sure your headers and body are encoded properly IF you set an encoding.
+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;
+
+ 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
+ $c->response->body( $c->encoding->encode( $body, $c->_encode_check ) )
+ if ref(\$body) eq 'SCALAR';
+}
+
=head2 $c->finalize_output
An alias for finalize_body.
$status = $c->finalize;
} catch {
#rethow if this can be handled by middleware
- if(blessed $_ && ($_->can('as_psgi') || $_->can('code'))) {
+ if ( $class->_handle_http_exception($_) ) {
$_->can('rethrow') ? $_->rethrow : croak $_;
}
chomp(my $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_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
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! 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
}
}
+=head2 $c->setup_encoding
+
+Sets up the input/output encoding. See L<ENCODING>
+
+=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 {
+ Encode::is_utf8( $value ) ?
+ $value
+ : $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
return $class;
}
- sub _default_plugins { return qw(Unicode::Encoding) }
+ sub _default_plugins { return qw() }
sub setup_plugins {
my ( $class, $plugins ) = @_;
$class => @roles
) if @roles;
}
-}
+}
=head2 registered_middlewares
sub setup_middleware {
my $class = shift;
- my @middleware_definitions = @_ ?
+ my @middleware_definitions = @_ ?
reverse(@_) : reverse(@{$class->config->{'psgi_middleware'}||[]});
my @middleware = ();
->can('build_cgi_struct')->($params);
},
'application/json' => sub {
- Class::Load::load_first_existing_class('JSON::MaybeXS', 'JSON')
- ->can('decode_json')->(do { local $/; $_->getline });
- },
+ my ($fh, $req) = @_;
+ my $parser = Class::Load::load_first_existing_class('JSON::MaybeXS', 'JSON');
+ my $slurped;
+ return eval {
+ local $/;
+ $slurped = $fh->getline;
+ $parser->can("decode_json")->($slurped);
+ } || Catalyst::Exception->throw(sprintf "Error Parsing POST '%s', Error: %s", (defined($slurped) ? $slurped : 'undef') ,$@);
+ },
};
}
+sub _handle_http_exception {
+ my ( $self, $error ) = @_;
+ if (
+ !$self->config->{always_catch_http_exceptions}
+ && blessed $error
+ && (
+ $error->can('as_psgi')
+ || ( $error->can('code')
+ && $error->code =~ m/^[1-5][0-9][0-9]$/ )
+ )
+ )
+ {
+ return 1;
+ }
+}
+
=head2 $c->stack
Returns an arrayref of the internal execution stack (actions that are
=item *
+C<always_catch_http_exceptions> - As of version 5.90060 Catalyst
+rethrows errors conforming to the interface described by
+L<Plack::Middleware::HTTPExceptions> and lets the middleware deal with it.
+Set true to get the deprecated behaviour and have Catalyst catch HTTP exceptions.
+
+=item *
+
C<default_model> - The default model picked if you say C<< $c->model >>. See L<< /$c->model($name) >>.
=item *
=item *
C<use_request_uri_for_path> - Controls if the C<REQUEST_URI> or C<PATH_INFO> environment
-variable should be used for determining the request path.
+variable should be used for determining the request path.
Most web server environments pass the requested path to the application using environment variables,
from which Catalyst has to reconstruct the request base (i.e. the top level path to / in the application,
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 *
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
+chain when there is an error raised in any action (thus terminating the chain
early.)
use like:
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
+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
sub throws_exception :Local {
my ($self, $c) = @_;
- http_throw(SeeOther => { location =>
+ http_throw(SeeOther => { location =>
$c->uri_for($self->action_for('redirect')) });
}
Danijel Milicevic C<me@danijel.de>
+davewood: David Schmidt <davewood@cpan.org>
+
David Kamholz E<lt>dkamholz@cpan.orgE<gt>
David Naughton, C<naughton@umn.edu>
projects / catagits/Catalyst-Runtime.git / blobdiff