[Catalyst-commits] r10019 - in HTTP-Request-AsCGI/trunk: lib/HTTP/Request t

[caelum at dev.catalyst.perl.org]

Author: caelum
Date: 2009-05-05 19:40:17 +0000 (Tue, 05 May 2009)
New Revision: 10019

Modified:
   HTTP-Request-AsCGI/trunk/lib/HTTP/Request/AsCGI.pm
   HTTP-Request-AsCGI/trunk/t/05env.t
Log:
AsCGI - check that utf8 paths survive, unescape passed in PATH_INFO

Modified: HTTP-Request-AsCGI/trunk/lib/HTTP/Request/AsCGI.pm
===================================================================
--- HTTP-Request-AsCGI/trunk/lib/HTTP/Request/AsCGI.pm	2009-05-05 19:31:20 UTC (rev 10018)
+++ HTTP-Request-AsCGI/trunk/lib/HTTP/Request/AsCGI.pm	2009-05-05 19:40:17 UTC (rev 10019)
@@ -5,6 +5,8 @@
 use bytes;
 use base 'Class::Accessor::Fast';
 
+our $VERSION = '0.9';
+
 use Carp;
 use HTTP::Response;
 use IO::Handle;
@@ -28,8 +30,8 @@
 my %reserved = map { sprintf('%02x', ord($_)) => 1 } split //, $URI::reserved;
 sub _uri_safe_unescape {
     my ($s) = @_;
-    $s =~ s/%([a-fA-F0-9]{2})/$reserved{lc($1)} ? "%$1" : chr(hex($1))/ge;
-    $s;
+    $s =~ s/%([a-fA-F0-9]{2})/$reserved{lc($1)} ? "%$1" : pack('C', hex($1))/ge;
+    $s
 }
 
 sub new {
@@ -58,7 +60,7 @@
         GATEWAY_INTERFACE => 'CGI/1.1',
         HTTP_HOST         => $uri->host_port,
         HTTPS             => ( $uri->scheme eq 'https' ) ? 'ON' : 'OFF',  # not in RFC 3875
-        PATH_INFO         => _uri_safe_unescape($uri->path),
+        PATH_INFO         => $uri->path,
         QUERY_STRING      => $uri->query || '',
         SCRIPT_NAME       => '/',
         SERVER_NAME       => $uri->host,
@@ -73,6 +75,8 @@
         @_
     };
 
+    $environment->{PATH_INFO} = _uri_safe_unescape($environment->{PATH_INFO});
+
     foreach my $field ( $request->headers->header_field_names ) {
 
         my $key = uc("HTTP_$field");

Modified: HTTP-Request-AsCGI/trunk/t/05env.t
===================================================================
--- HTTP-Request-AsCGI/trunk/t/05env.t	2009-05-05 19:31:20 UTC (rev 10018)
+++ HTTP-Request-AsCGI/trunk/t/05env.t	2009-05-05 19:40:17 UTC (rev 10019)
@@ -7,9 +7,15 @@
 
 use HTTP::Request;
 use HTTP::Request::AsCGI;
+use Encode;
 
 my $r = HTTP::Request->new( GET => 'http://www.host.com/cgi-bin/script.cgi/my%20path%2F?a=1&b=2', [ 'X-Test' => 'Test' ] );
-my %e = ( SCRIPT_NAME => '/cgi-bin/script.cgi' );
+my %e = (
+  SCRIPT_NAME => '/cgi-bin/script.cgi',
+# test a utf-8 PATH_INFO, sort of (and safe decoding)
+  PATH_INFO =>
+  '/foo%2F%C3%90%C2%91%C3%90%C2%AF%C3%A9%C2%99%C2%B0%C3%A8%C2%8C%C2%8E',
+);
 my $c = HTTP::Request::AsCGI->new( $r, %e );
 $c->stdout(undef);
 
@@ -18,7 +24,7 @@
 is( $ENV{GATEWAY_INTERFACE}, 'CGI/1.1', 'GATEWAY_INTERFACE' );
 is( $ENV{HTTP_HOST}, 'www.host.com:80', 'HTTP_HOST' );
 is( $ENV{HTTP_X_TEST}, 'Test', 'HTTP_X_TEST' );
-is( $ENV{PATH_INFO}, '/my path%2F', 'PATH_INFO' );
+is( decode('UTF-8', $ENV{PATH_INFO}), '/foo%2FБЯ陰茎', 'PATH_INFO');
 is( $ENV{QUERY_STRING}, 'a=1&b=2', 'QUERY_STRING' );
 is( $ENV{SCRIPT_NAME}, '/cgi-bin/script.cgi', 'SCRIPT_NAME' );
 is( $ENV{REQUEST_METHOD}, 'GET', 'REQUEST_METHOD' );