X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst%2FPlugin%2FUnicode%2FEncoding.pm;h=e5adb8ebadd1f1c570d52af214b928cadbf5cc21;hp=5cfa30eac60077b263b49af03420b64a2893e63b;hb=64069db0679b6e0b497d11a2d5b1b7de673ad848;hpb=b498099290e08e2dbd09561248e7deaed58fa3bf diff --git a/lib/Catalyst/Plugin/Unicode/Encoding.pm b/lib/Catalyst/Plugin/Unicode/Encoding.pm index 5cfa30e..e5adb8e 100644 --- a/lib/Catalyst/Plugin/Unicode/Encoding.pm +++ b/lib/Catalyst/Plugin/Unicode/Encoding.pm @@ -1,281 +1,25 @@ 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'/ ); - } - - $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; - - 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 - $_->{filename} = try { - $enc->decode( $_->{filename}, $CHECK ) - } catch { - $c->handle_unicode_encoding_exception({ - param_value => $_->{filename}, - error_msg => $_, - encoding_step => 'uploads', - }); - } for ( ref($value) eq 'ARRAY' ? @{$value} : $value ); - } -} - -sub prepare_action { - my $c = shift; - - my $ret = $c->next::method(@_); - - 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 explict undef encoding to disable default of utf-8 - my $enc = exists $conf->{encoding} ? delete $conf->{encoding} : 'UTF-8'; - $self->encoding( $enc ); - - return $self->next::method(@_); -} - -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 = '5.90124'; 1; -__END__ - =head1 NAME Catalyst::Plugin::Unicode::Encoding - Unicode aware Catalyst -=head1 SYNOPSIS - - use Catalyst qw[Unicode::Encoding]; - - MyApp->config( encoding => 'UTF-8' ); # A valid Encode encoding - - =head1 DESCRIPTION -On request, decodes all params from encoding into a sequence of -logical characters. On response, encodes body into encoding. - -=head1 METHODS - -=over 4 - -=item encoding - -Returns an instance of an C encoding - - print $c->encoding->name - -=back - -=head1 OVERLOADED METHODS - -=over - -=item finalize_headers - -Encodes body into encoding. - -=item prepare_uploads - -Decodes parameters, query_parameters, body_parameters and filenames -in file uploads into a sequence of logical characters. - -=item prepare_action - -Decodes request arguments (i.e. C<< $c->request->arguments >>) and -captures (i.e. C<< $c->request->captures >>). - -=item setup - -Setups C<< $c->encoding >> with encoding specified in C<< $c->config->{encoding} >>. - -=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 recieved 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 SEE ALSO - -L, L, L, L. +This plugin has been merged into core. This package only exists to clean out +any existing versions on your installed system. =head1 AUTHORS -Christian Hansen, C - -Masahiro Chiba - -Tomas Doran, C +Catalyst Contributors, see Catalyst.pm -=head1 LICENSE +=head1 COPYRIGHT -This library is free software . You can redistribute it and/or modify -it under the same terms as perl itself. +This library is free software. You can redistribute it and/or modify +it under the same terms as Perl itself. =cut