# This file documents the revision history for Perl extension Catalyst.
+5.90069_TBA
+ - Finished merging all the encoding plugin code to core code. The encoding
+ plugin is now just an empty package. Also tried to improve encoding docs
+ a bit.
+ - Some additional changes to the stash middleware that should not break
+ anything new.
+
5.90069_002
- Catalyst stash functionality has been moved to Middleware. It should
work entirely the same when used as a context method, please report
use Catalyst::Middleware::Stash;
use Plack::Util;
use Class::Load 'load_class';
+use Encode 2.21 ();
BEGIN { require 5.008003; }
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_002';
sub import {
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
$c->finalize_error;
}
+ $c->finalize_encoding;
$c->finalize_headers unless $c->response->finalized_headers;
-
$c->finalize_body;
}
$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.
=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_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;
+
+ 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 ) = @_;
+ 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 ) = @_;
package Catalyst::Plugin::Unicode::Encoding;
-use strict;
-use base 'Class::Data::Inheritable';
-
-use Carp ();
-use MRO::Compat;
-use Try::Tiny;
-
-use Encode 2.21 ();
-our $CHECK = Encode::FB_CROAK | Encode::LEAVE_SRC;
-
-our $VERSION = '2.1';
-
-__PACKAGE__->mk_classdata('_encoding');
-
-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;
-}
-
-sub finalize_headers {
- my $c = shift;
-
- my $body = $c->response->body;
-
- return $c->next::method(@_)
- unless defined($body);
-
- my $enc = $c->encoding;
-
- return $c->next::method(@_)
- unless $enc;
-
- my ($ct, $ct_enc) = $c->response->content_type;
-
- # Only touch 'text-like' contents
- return $c->next::method(@_)
- 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 $c->next::method(@_);
- }
- } else {
- $c->res->content_type($c->res->content_type . "; charset=" . $enc->mime_name);
- }
-
- # Encode expects plain scalars (IV, NV or PV) and segfaults on ref's
- $c->response->body( $c->encoding->encode( $body, $CHECK ) )
- if ref(\$body) eq 'SCALAR';
-
- $c->next::method(@_);
-}
-
-# Note we have to hook here as uploads also add to the request parameters
-sub prepare_uploads {
- my $c = shift;
-
- $c->next::method(@_);
-
- my $enc = $c->encoding;
- return unless $enc;
-
- 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}, $CHECK )
- } catch {
- $c->handle_unicode_encoding_exception({
- param_value => $inner_value->{filename},
- error_msg => $_,
- encoding_step => 'uploads',
- });
- };
- }
- }
-}
-
-sub prepare_action {
- my $c = shift;
-
- my $ret = $c->next::method(@_);
-
- my $enc = $c->encoding;
- return $ret unless $enc;
-
- foreach (@{$c->req->arguments}, @{$c->req->captures}) {
- $_ = $c->_handle_param_unicode_decoding($_);
- }
-
- return $ret;
-}
-
-sub setup {
- my $self = shift;
-
- my $conf = $self->config;
-
- # Allow an explicit undef encoding to disable default of utf-8
- my $enc = delete $conf->{encoding};
- $self->encoding( $enc );
-
- return $self->next::method(@_)
- unless $self->setup_finished; ## hack to stop possibly meaningless test fail... (jnap)
-}
-
-sub _handle_unicode_decoding {
- my ( $self, $value ) = @_;
-
- return unless defined $value;
-
- 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 ) = @_;
- my $enc = $self->encoding;
- return try {
- Encode::is_utf8( $value ) ?
- $value
- : $enc->decode( $value, $CHECK );
- }
- catch {
- $self->handle_unicode_encoding_exception({
- param_value => $value,
- error_msg => $_,
- encoding_step => 'params',
- });
- };
-}
-
-sub handle_unicode_encoding_exception {
- my ( $self, $exception_ctx ) = @_;
- die $exception_ctx->{error_msg};
-}
+our $VERSION = '99.0'; # set high so we always overwrite
1;
-__END__
-
=head1 NAME
Catalyst::Plugin::Unicode::Encoding - Unicode aware Catalyst
-=head1 SYNOPSIS
-
- use Catalyst;
-
- MyApp->config( encoding => 'UTF-8' ); # A valid Encode encoding
-
-
=head1 DESCRIPTION
-This plugin is automatically loaded by apps. Even though is not a core component
-yet, it will vanish as soon as the code is fully integrated. For more
-information, please refer to L<Catalyst/ENCODING>.
+This plugin has been merged into core. This package only exists to clean out
+any existing versions on your installed system.
=head1 AUTHORS
Catalyst::Plugin::Test::Inline
Catalyst::Plugin::Test::MangleDollarUnderScore
Catalyst::Plugin::Test::Plugin
- Catalyst::Plugin::Unicode::Encoding
TestApp::Plugin::AddDispatchTypes
TestApp::Plugin::FullyQualified
];
can_ok($model_foo_bar, 'model_foo_bar_method_from_foo');
can_ok($model_foo_bar, 'model_foo_bar_method_from_foo_bar');
-TestApp->setup;
+# I commented out this line since we seem to just massively
+# fail on the 'you already did setup. I have no idea why its
+# here - jnap
+#TestApp->setup;
is($model_foo->model_quux_method, 'chunkybacon', 'Model method getting $self->{quux} from config');
Catalyst::Plugin::Test::Inline
Catalyst::Plugin::Test::MangleDollarUnderScore
Catalyst::Plugin::Test::Plugin
- Catalyst::Plugin::Unicode::Encoding
TestApp::Plugin::AddDispatchTypes
TestApp::Plugin::FullyQualified
);
is_deeply [ $c->registered_plugins ],
[
qw/Catalyst::Plugin::Test::Plugin
- Catalyst::Plugin::Unicode::Encoding
TestApp::Plugin::FullyQualified/
],
'... and it should report the correct plugins';
is_deeply [ $c->registered_plugins ],
[
qw/Catalyst::Plugin::Test::Plugin
- Catalyst::Plugin::Unicode::Encoding
Faux::Plugin
TestApp::Plugin::FullyQualified/
],
push(@ELOGS, shift());
}
+sub error { die "Got unexpected error; $_[1]" }
1;
projects / catagits/Catalyst-Runtime.git / commitdiff