1 package Catalyst::Plugin::Unicode::Encoding;
4 use base 'Class::Data::Inheritable';
11 our $CHECK = Encode::FB_CROAK | Encode::LEAVE_SRC;
15 __PACKAGE__->mk_classdata('_encoding');
22 # Let it be set to undef
23 if (my $wanted = shift) {
24 $encoding = Encode::find_encoding($wanted)
25 or Carp::croak( qq/Unknown encoding '$wanted'/ );
26 binmode(STDERR, ':encoding(' . $encoding->name . ')');
33 ? $c->{encoding} = $encoding
34 : $c->_encoding($encoding);
36 $encoding = ref $c && exists $c->{encoding}
44 sub finalize_headers {
47 my $body = $c->response->body;
49 return $c->next::method(@_)
50 unless defined($body);
52 my $enc = $c->encoding;
54 return $c->next::method(@_)
57 my ($ct, $ct_enc) = $c->response->content_type;
59 # Only touch 'text-like' contents
60 return $c->next::method(@_)
61 unless $c->response->content_type =~ /^text|xml$|javascript$/;
63 if ($ct_enc && $ct_enc =~ /charset=([^;]*)/) {
64 if (uc($1) ne uc($enc->mime_name)) {
65 $c->log->debug("Unicode::Encoding is set to encode in '" .
67 "', content type is '$1', not encoding ");
68 return $c->next::method(@_);
71 $c->res->content_type($c->res->content_type . "; charset=" . $enc->mime_name);
74 # Encode expects plain scalars (IV, NV or PV) and segfaults on ref's
75 $c->response->body( $c->encoding->encode( $body, $CHECK ) )
76 if ref(\$body) eq 'SCALAR';
81 # Note we have to hook here as uploads also add to the request parameters
87 my $enc = $c->encoding;
90 for my $key (qw/ parameters query_parameters body_parameters /) {
91 for my $value ( values %{ $c->request->{$key} } ) {
92 # N.B. Check if already a character string and if so do not try to double decode.
93 # http://www.mail-archive.com/catalyst@lists.scsys.co.uk/msg02350.html
94 # this avoids exception if we have already decoded content, and is _not_ the
95 # same as not encoding on output which is bad news (as it does the wrong thing
96 # for latin1 chars for example)..
97 $value = $c->_handle_unicode_decoding($value);
100 for my $value ( values %{ $c->request->uploads } ) {
101 # skip if it fails for uploads, as we don't usually want uploads touched
103 for my $inner_value ( ref($value) eq 'ARRAY' ? @{$value} : $value ) {
104 $inner_value->{filename} = try {
105 $enc->decode( $inner_value->{filename}, $CHECK )
107 $c->handle_unicode_encoding_exception({
108 param_value => $inner_value->{filename},
110 encoding_step => 'uploads',
120 my $ret = $c->next::method(@_);
122 my $enc = $c->encoding;
123 return $ret unless $enc;
125 foreach (@{$c->req->arguments}, @{$c->req->captures}) {
126 $_ = $c->_handle_param_unicode_decoding($_);
135 my $conf = $self->config;
137 # Allow an explicit undef encoding to disable default of utf-8
138 my $enc = delete $conf->{encoding};
139 $self->encoding( $enc );
141 return $self->next::method(@_)
142 unless $self->setup_finished; ## hack to stop possibly meaningless test fail... (jnap)
145 sub _handle_unicode_decoding {
146 my ( $self, $value ) = @_;
148 return unless defined $value;
150 if ( ref $value eq 'ARRAY' ) {
151 foreach ( @$value ) {
152 $_ = $self->_handle_unicode_decoding($_);
156 elsif ( ref $value eq 'HASH' ) {
157 foreach ( values %$value ) {
158 $_ = $self->_handle_unicode_decoding($_);
163 return $self->_handle_param_unicode_decoding($value);
167 sub _handle_param_unicode_decoding {
168 my ( $self, $value ) = @_;
169 my $enc = $self->encoding;
171 Encode::is_utf8( $value ) ?
173 : $enc->decode( $value, $CHECK );
176 $self->handle_unicode_encoding_exception({
177 param_value => $value,
179 encoding_step => 'params',
184 sub handle_unicode_encoding_exception {
185 my ( $self, $exception_ctx ) = @_;
186 die $exception_ctx->{error_msg};
195 Catalyst::Plugin::Unicode::Encoding - Unicode aware Catalyst
201 MyApp->config( encoding => 'UTF-8' ); # A valid Encode encoding
206 This plugin is automatically loaded by apps. Even though is not a core component
207 yet, it will vanish as soon as the code is fully integrated. For more
208 information, please refer to L<Catalyst/ENCODING>.
212 Catalyst Contributors, see Catalyst.pm
216 This library is free software. You can redistribute it and/or modify
217 it under the same terms as Perl itself.