fix unicode in chain and path parts + debug console

diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index 38c1032..1b73f23 100644 (file)
--- a/lib/Catalyst.pm
+++ b/lib/Catalyst.pm
@@ -50,7 +50,7 @@ use Plack::Middleware::RemoveRedundantBody;
 use Catalyst::Middleware::Stash;
 use Plack::Util;
 use Class::Load 'load_class';
-use Encode 2.21 'encode_utf8';
+use Encode 2.21 'decode_utf8', 'encode_utf8';
 
 BEGIN { require 5.008003; }
 
@@ -2063,8 +2063,9 @@ sub finalize_encoding {
 
     # 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';
+    if (ref(\$body) eq 'SCALAR') {
+      $c->response->body( $c->encoding->encode( $body, $c->_encode_check ) );
+    };
 }
 
 =head2 $c->finalize_output
@@ -2372,6 +2373,10 @@ sub log_request {
     $method ||= '';
     $path = '/' unless length $path;
     $address ||= '';
+
+    $path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
+    $path = decode_utf8($path);
+
     $c->log->debug(qq/"$method" request for "$path" from "$address"/);
 
     $c->log_request_headers($request->headers);
@@ -2562,7 +2567,7 @@ sub prepare_uploads {
     return unless $enc;
 
     # Uggg we hook prepare uploads to do the encoding crap on post and query
-    # parameters!  Sorry -jnap
+    # parameters!  Cargo culted from old encoding plugin.  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.

diff --git a/lib/Catalyst/DispatchType/Chained.pm b/lib/Catalyst/DispatchType/Chained.pm
index 05fc514..2888607 100644 (file)
--- a/lib/Catalyst/DispatchType/Chained.pm
+++ b/lib/Catalyst/DispatchType/Chained.pm
@@ -8,6 +8,7 @@ use Catalyst::ActionChain;
 use Catalyst::Utils;
 use URI;
 use Scalar::Util ();
+use Encode 2.21 'decode_utf8';
 
 has _endpoints => (
                    is => 'rw',
@@ -140,7 +141,8 @@ sub list {
             push(@rows, [ '', $name ]);
         }
         push(@rows, [ '', (@rows ? "=> " : '').($extra ? "$extra " : '')."/${endpoint}". ($consumes ? " :$consumes":"" ) ]);
-        $rows[0][0] = join('/', '', @parts) || '/';
+        my @display_parts = map { $_ =~s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; decode_utf8 $_ } @parts;
+        $rows[0][0] = join('/', '', @display_parts) || '/';
         $paths->row(@$_) for @rows;
     }
 
@@ -362,9 +364,12 @@ sub register {
         );
     }
 
-    $action->attributes->{PathPart} = [ $part ];
+    my $encoded_part = URI->new($part)->canonical;
+    $encoded_part =~ s{(?<=[^/])/+\z}{};
 
-    unshift(@{ $children->{$part} ||= [] }, $action);
+    $action->attributes->{PathPart} = [ $encoded_part ];
+
+    unshift(@{ $children->{$encoded_part} ||= [] }, $action);
 
     $self->_actions->{'/'.$action->reverse} = $action;
 

diff --git a/lib/Catalyst/DispatchType/Path.pm b/lib/Catalyst/DispatchType/Path.pm
index 0578ff4..acf0f3a 100644 (file)
--- a/lib/Catalyst/DispatchType/Path.pm
+++ b/lib/Catalyst/DispatchType/Path.pm
@@ -6,6 +6,7 @@ extends 'Catalyst::DispatchType';
 use Text::SimpleTable;
 use Catalyst::Utils;
 use URI;
+use Encode 2.21 'decode_utf8';
 
 has _paths => (
                is => 'rw',
@@ -60,7 +61,8 @@ sub list {
 
             my $display_path = "/$path/$parts";
             $display_path =~ s{/{1,}}{/}g;
-
+            $display_path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; # deconvert urlencoded for pretty view 
+            $display_path = decode_utf8 $display_path;  # URI does encoding
             $paths->row( $display_path, "/$action" );
         }
     }

diff --git a/lib/Catalyst/Dispatcher.pm b/lib/Catalyst/Dispatcher.pm
index 6fde402..12040b2 100644 (file)
--- a/lib/Catalyst/Dispatcher.pm
+++ b/lib/Catalyst/Dispatcher.pm
@@ -15,6 +15,7 @@ use Text::SimpleTable;
 use Tree::Simple;
 use Tree::Simple::Visitor::FindByPath;
 use Class::Load qw(load_class try_load_class);
+use Encode 2.21 'decode_utf8';
 
 use namespace::clean -except => 'meta';
 
@@ -108,6 +109,9 @@ sub dispatch {
     }
     else {
         my $path  = $c->req->path;
+        $path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
+        $path = decode_utf8($path);
+
         my $error = $path
           ? qq/Unknown resource "$path"/
           : "No default action defined";
@@ -385,10 +389,14 @@ sub prepare_action {
 
     s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg for grep { defined } @{$req->captures||[]};
 
-    $c->log->debug( 'Path is "' . $req->match . '"' )
-      if ( $c->debug && defined $req->match && length $req->match );
+    if($c->debug && defined $req->match && length $req->match) {
+      my $match = $req->match;
+      $match =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
+      $match = decode_utf8($match);
+      $c->log->debug( 'Path is "' . $match . '"' )
+    }
 
-    $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
+    $c->log->debug( 'Arguments are "' . join( '/', map { decode_utf8 $_ } @args ) . '"' )
       if ( $c->debug && @args );
 }
 

diff --git a/lib/Catalyst/Log.pm b/lib/Catalyst/Log.pm
index e70197f..a599284 100644 (file)
--- a/lib/Catalyst/Log.pm
+++ b/lib/Catalyst/Log.pm
@@ -141,6 +141,7 @@ sub _send_to_log {
     if ($self->can('_has_psgi_errors') and $self->_has_psgi_errors) {
         $self->_psgi_errors->print(@_);
     } else {
+        binmode STDERR, ":utf8";
         print STDERR @_;
     }
 }

diff --git a/t/utf_incoming.t b/t/utf_incoming.t
new file mode 100644 (file)
index 0000000..9a3d2d8
--- /dev/null
+++ b/t/utf_incoming.t
@@ -0,0 +1,80 @@
+use utf8;
+use warnings;
+use strict;
+use Test::More;
+
+# Test cases for incoming utf8 
+
+{
+  package MyApp::Controller::Root;
+  $INC{'MyApp/Controller/Root.pm'} = __FILE__;
+
+  use base 'Catalyst::Controller';
+
+  sub heart :Path('♥') {
+    my ($self, $c) = @_;
+    $c->response->content_type('text/html');
+    $c->response->body("<p>This is path-heart action ♥</p>");
+    # We let the content length middleware find the length...
+  }
+
+  sub hat :Path('^') {
+    my ($self, $c) = @_;
+    $c->response->content_type('text/html');
+    $c->response->body("<p>This is path-hat action ^</p>");
+  }
+
+  sub base :Chained('/') CaptureArgs(0) { }
+    sub link :Chained('base') PathPart('♥') Args(0) {
+      my ($self, $c) = @_;
+      $c->response->content_type('text/html');
+      $c->response->body("<p>This is base-link action ♥</p>");
+    }
+
+  package MyApp;
+  use Catalyst;
+
+  MyApp->config(encoding=>'UTF-8');
+
+  Test::More::ok(MyApp->setup, 'setup app');
+}
+
+ok my $psgi = MyApp->psgi_app, 'build psgi app';
+
+use Catalyst::Test 'MyApp';
+use Encode 2.21 'decode_utf8';
+
+{
+  my $res = request "/root/♥";
+
+  is $res->code, 200, 'OK';
+  is decode_utf8($res->content), '<p>This is path-heart action ♥</p>', 'correct body';
+  is $res->content_length, 36, 'correct length';
+}
+
+{
+  my $res = request "/root/^";
+
+  is $res->code, 200, 'OK';
+  is decode_utf8($res->content), '<p>This is path-hat action ^</p>', 'correct body';
+  is $res->content_length, 32, 'correct length';
+}
+
+{
+  my $res = request "/base/♥";
+
+  is $res->code, 200, 'OK';
+  is decode_utf8($res->content), '<p>This is base-link action ♥</p>', 'correct body';
+  is $res->content_length, 35, 'correct length';
+}
+
+{
+  my $res = request "/base/♥?♥=♥♥";
+
+  is $res->code, 200, 'OK';
+  is decode_utf8($res->content), '<p>This is base-link action ♥</p>', 'correct body';
+  is $res->content_length, 35, 'correct length';
+}
+
+
+done_testing;