[Catalyst-commits] r11840 - in
Catalyst-Plugin-Unicode-Encoding/branches/support_params_nested:
. lib/Catalyst/Plugin/Unicode t t/lib
chiba at dev.catalyst.perl.org
chiba at dev.catalyst.perl.org
Sun Nov 15 17:05:51 GMT 2009
Author: chiba
Date: 2009-11-15 17:05:51 +0000 (Sun, 15 Nov 2009)
New Revision: 11840
Added:
Catalyst-Plugin-Unicode-Encoding/branches/support_params_nested/t/07request_decode_nested.t
Modified:
Catalyst-Plugin-Unicode-Encoding/branches/support_params_nested/Makefile.PL
Catalyst-Plugin-Unicode-Encoding/branches/support_params_nested/lib/Catalyst/Plugin/Unicode/Encoding.pm
Catalyst-Plugin-Unicode-Encoding/branches/support_params_nested/t/lib/TestApp.pm
Log:
implement support_params_nested
Modified: Catalyst-Plugin-Unicode-Encoding/branches/support_params_nested/Makefile.PL
===================================================================
--- Catalyst-Plugin-Unicode-Encoding/branches/support_params_nested/Makefile.PL 2009-11-15 15:28:41 UTC (rev 11839)
+++ Catalyst-Plugin-Unicode-Encoding/branches/support_params_nested/Makefile.PL 2009-11-15 17:05:51 UTC (rev 11840)
@@ -4,9 +4,11 @@
requires 'Encode' => '2.21';
requires 'Catalyst' => '5.80';
+requires 'Data::Visitor::Callback';
test_requires 'Test::WWW::Mechanize::Catalyst' => 0.51;
test_requires 'IO::Scalar';
+test_requires 'Catalyst::Plugin::Params::Nested';
resources repository => 'http://dev.catalyst.perl.org/repos/Catalyst/Catalyst-Plugin-Unicode-Encoding/';
Modified: Catalyst-Plugin-Unicode-Encoding/branches/support_params_nested/lib/Catalyst/Plugin/Unicode/Encoding.pm
===================================================================
--- Catalyst-Plugin-Unicode-Encoding/branches/support_params_nested/lib/Catalyst/Plugin/Unicode/Encoding.pm 2009-11-15 15:28:41 UTC (rev 11839)
+++ Catalyst-Plugin-Unicode-Encoding/branches/support_params_nested/lib/Catalyst/Plugin/Unicode/Encoding.pm 2009-11-15 17:05:51 UTC (rev 11840)
@@ -7,6 +7,8 @@
use Encode 2.21 ();
use MRO::Compat;
+use Data::Visitor::Callback;
+
our $VERSION = '0.5';
our $CHECK = Encode::FB_CROAK | Encode::LEAVE_SRC;
@@ -80,26 +82,29 @@
my $enc = $c->encoding;
+ my $visitor = Data::Visitor::Callback->new(
+ value => sub {
+ return unless defined($_);
+
+ # 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)..
+ $_ = Encode::is_utf8( $_ ) ? $_ : $enc->decode( $_, $CHECK );
+ },
+ 'Catalyst::Request::Upload' => sub {
+ $_->{filename} = $enc->decode( $_->{filename}, $CHECK )
+ },
+ );
+
for my $key (qw/ parameters query_parameters body_parameters /) {
for my $value ( values %{ $c->request->{$key} } ) {
-
- # TODO: Hash support from the Params::Nested
- if ( ref $value && ref $value ne 'ARRAY' ) {
- next;
- }
- for ( ref($value) ? @{$value} : $value ) {
- # 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)..
- $_ = Encode::is_utf8( $_ ) ? $_ : $enc->decode( $_, $CHECK );
- }
+ $visitor->visit($value);
}
}
for my $value ( values %{ $c->request->uploads } ) {
- $_->{filename} = $enc->decode( $_->{filename}, $CHECK )
- for ( ref($value) eq 'ARRAY' ? @{$value} : $value );
+ $visitor->visit($value);
}
}
Added: Catalyst-Plugin-Unicode-Encoding/branches/support_params_nested/t/07request_decode_nested.t
===================================================================
--- Catalyst-Plugin-Unicode-Encoding/branches/support_params_nested/t/07request_decode_nested.t (rev 0)
+++ Catalyst-Plugin-Unicode-Encoding/branches/support_params_nested/t/07request_decode_nested.t 2009-11-15 17:05:51 UTC (rev 11840)
@@ -0,0 +1,152 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use Test::More tests => 3 * 10;
+use utf8;
+
+# setup library path
+use FindBin qw($Bin);
+use lib "$Bin/lib";
+
+BEGIN{
+ $ENV{TESTAPP_PARAMS_NESTED} = 1;
+}
+use Catalyst::Test 'TestApp';
+use Encode;
+use HTTP::Request::Common;
+use URI::Escape;
+
+my $encode_str = "\x{e3}\x{81}\x{82}"; # e38182 is japanese 'あ'
+my $decode_str = Encode::decode('utf-8' => $encode_str);
+my $escape_str = uri_escape_utf8($decode_str);
+
+
+{
+ my $foo_data = $decode_str;
+ check_parameter(GET("/?foo=$escape_str") => $foo_data);
+ check_parameter(POST('/', ['foo' => $encode_str]) => $foo_data);
+ check_parameter(
+ POST('/',
+ Content_Type => 'form-data',
+ Content => [
+ 'foo' => [
+ "$Bin/06request_decode.t",
+ $encode_str,
+ ]
+ ],
+ ) => $foo_data
+ );
+}
+
+{ # Array
+ my $foo_data = [$decode_str, $decode_str];
+ check_parameter(GET("/?foo=$escape_str&foo=$escape_str") => $foo_data);
+ check_parameter(POST('/', ['foo' => $encode_str, 'foo' => $encode_str]) => $foo_data);
+ check_parameter(
+ POST('/',
+ Content_Type => 'form-data',
+ Content => [
+ 'foo' => [
+ "$Bin/06request_decode.t",
+ $encode_str,
+ ],
+ 'foo' => [
+ "$Bin/06request_decode.t",
+ $encode_str,
+ ]
+ ],
+ ) => $foo_data
+ );
+}
+{ # Array[2]
+ my $foo_data = [$decode_str, undef, $decode_str];
+ check_parameter(GET("/?foo[0]=$escape_str&foo[2]=$escape_str") => $foo_data);
+ check_parameter(POST('/', ['foo[0]' => $encode_str, 'foo[2]' => $encode_str]) => $foo_data);
+ # no support filename nested param now(C::P::Params::Nested version 0.02)
+ #check_parameter(
+ # POST('/',
+ # Content_Type => 'form-data',
+ # Content => [
+ # 'foo[0]' => [
+ # "$Bin/06request_decode.t",
+ # $encode_str,
+ # ],
+ # 'foo[2]' => [
+ # "$Bin/06request_decode.t",
+ # $encode_str,
+ # ]
+ # ],
+ # ) => $foo_data
+ #);
+}
+
+{ # Hash
+ my $foo_data = {bar => $decode_str, baz => $decode_str};
+ check_parameter(GET("/?foo[bar]=$escape_str&foo[baz]=$escape_str") => $foo_data);
+ check_parameter(POST('/', ['foo[bar]' => $encode_str, 'foo[baz]' => $encode_str]) => $foo_data);
+ # no support filename nested param now(C::P::Params::Nested version 0.02)
+ #check_parameter(
+ # POST('/',
+ # Content_Type => 'form-data',
+ # Content => [
+ # 'foo[bar]' => [
+ # "$Bin/06request_decode.t",
+ # $encode_str,
+ # ],
+ # 'foo[baz]' => [
+ # "$Bin/06request_decode.t",
+ # $encode_str,
+ # ]
+ # ],
+ # ) => $foo_data
+ #);
+}
+
+
+sub check_parameter {
+ my ( $request, $foo_data ) = @_;
+ my ( undef, $c ) = ctx_request($request);
+ is $c->res->output => '<h1>It works</h1>';
+
+ my $foo = get_foo($c);
+ ok is_utf8_deeply($foo);
+ is_deeply $foo => $foo_data;
+}
+
+sub is_utf8_deeply {
+ my $data = shift;
+
+ my $is_utf8 = 1;
+ my $check_depply; $check_depply =sub {
+ my $var = shift;
+ my $ref = ref($var);
+ if ($ref eq 'ARRAY') {
+ $check_depply->($_) for @$var;
+ }
+ elsif ($ref eq 'HASH') {
+ $check_depply->($_) for values %$var;
+ }
+ elsif ($ref eq 'SCALAR') {
+ $check_depply->($$var);
+ }
+ elsif ($ref eq '') {
+ return unless defined($_);
+ $is_utf8 = 0 unless utf8::is_utf8($var);
+ }
+ };
+ $check_depply->($data);
+
+ return $is_utf8;
+}
+
+sub get_foo {
+ my $c = shift;
+ my $foo = [$c->req->param('foo')];
+ if ( @$foo > 1 ) {
+ return $foo;
+ }
+ else {
+ return $foo->[0];
+ }
+}
Modified: Catalyst-Plugin-Unicode-Encoding/branches/support_params_nested/t/lib/TestApp.pm
===================================================================
--- Catalyst-Plugin-Unicode-Encoding/branches/support_params_nested/t/lib/TestApp.pm 2009-11-15 15:28:41 UTC (rev 11839)
+++ Catalyst-Plugin-Unicode-Encoding/branches/support_params_nested/t/lib/TestApp.pm 2009-11-15 17:05:51 UTC (rev 11840)
@@ -2,14 +2,17 @@
use strict;
use warnings;
use base qw/Catalyst/;
-use Catalyst qw/Unicode::Encoding/;
+use Catalyst;
+
__PACKAGE__->config(
encoding => $ENV{TESTAPP_ENCODING}
) if $ENV{TESTAPP_ENCODING};
__PACKAGE__->config('name' => 'TestApp');
-__PACKAGE__->setup;
+my @plugins = qw/Unicode::Encoding/;
+push @plugins, 'Params::Nested' if $ENV{TESTAPP_PARAMS_NESTED};
+__PACKAGE__->setup(@plugins);
1;
More information about the Catalyst-commits
mailing list