t/utf_incoming.t

   1 use utf8;
   2 use warnings;
   3 use strict;
   4 use Test::More;
   5 use HTTP::Request::Common;
   6 use HTTP::Message::PSGI ();
   7 use Encode 2.21 'decode_utf8', 'encode_utf8', 'encode';
   8 use File::Spec;
   9 use JSON::MaybeXS;
  10 use Scalar::Util ();
  11
  12 # Test cases for incoming utf8
  13
  14 {
  15   package MyApp::Controller::Root;
  16   $INC{'MyApp/Controller/Root.pm'} = __FILE__;
  17
  18   use base 'Catalyst::Controller';
  19
  20   sub heart :Path('♥') {
  21     my ($self, $c) = @_;
  22     $c->response->content_type('text/html');
  23     $c->response->body("<p>This is path-heart action ♥</p>");
  24     # We let the content length middleware find the length...
  25   }
  26
  27   sub hat :Path('^') {
  28     my ($self, $c) = @_;
  29     $c->response->content_type('text/html');
  30     $c->response->body("<p>This is path-hat action ^</p>");
  31   }
  32
  33   sub uri_for :Path('uri_for') {
  34     my ($self, $c) = @_;
  35     $c->response->content_type('text/html');
  36     $c->response->body("${\$c->uri_for($c->controller('Root')->action_for('argend'), ['♥'], '♥', {'♥'=>'♥♥'})}");
  37   }
  38
  39   sub heart_with_arg :Path('a♥') Args(1)  {
  40     my ($self, $c, $arg) = @_;
  41     $c->response->content_type('text/html');
  42     $c->response->body("<p>This is path-heart-arg action $arg</p>");
  43     Test::More::is $c->req->args->[0], '♥';
  44   }
  45
  46   sub base :Chained('/') CaptureArgs(0) { }
  47     sub link :Chained('base') PathPart('♥') Args(0) {
  48       my ($self, $c) = @_;
  49       $c->response->content_type('text/html');
  50       $c->response->body("<p>This is base-link action ♥</p>");
  51     }
  52     sub arg :Chained('base') PathPart('♥') Args(1) {
  53       my ($self, $c, $arg) = @_;
  54       $c->response->content_type('text/html');
  55       $c->response->body("<p>This is base-link action ♥ $arg</p>");
  56     }
  57     sub capture :Chained('base') PathPart('♥') CaptureArgs(1) {
  58       my ($self, $c, $arg) = @_;
  59       $c->stash(capture=>$arg);
  60     }
  61       sub argend :Chained('capture') PathPart('♥') Args(1) {
  62         my ($self, $c, $arg) = @_;
  63         $c->response->content_type('text/html');
  64
  65         Test::More::is $c->req->args->[0], '♥';
  66         Test::More::is $c->req->captures->[0], '♥';
  67         Test::More::is $arg, '♥';
  68         Test::More::is length($arg), 1, "got length of one";
  69
  70         $c->response->body("<p>This is base-link action ♥ ${\$c->req->args->[0]}</p>");
  71
  72         # Test to make sure redirect can now take an object (sorry don't have a better place for it
  73         # but wanted test coverage.
  74         my $location = $c->res->redirect( $c->uri_for($c->controller('Root')->action_for('uri_for')) );
  75         Test::More::ok !ref $location;
  76       }
  77
  78   sub stream_write :Local {
  79     my ($self, $c) = @_;
  80     $c->response->content_type('text/html');
  81     $c->response->write("<p>This is stream_write action ♥</p>");
  82   }
  83
  84   sub stream_write_fh :Local {
  85     my ($self, $c) = @_;
  86     $c->response->content_type('text/html');
  87
  88     my $writer = $c->res->write_fh;
  89     $writer->write_encoded('<p>This is stream_write_fh action ♥</p>');
  90     $writer->close;
  91   }
  92
  93   # Stream a file with utf8 chars directly, you don't need to decode
  94   sub stream_body_fh :Local {
  95     my ($self, $c) = @_;
  96     my $path = File::Spec->catfile('t', 'utf8.txt');
  97     open(my $fh, '<', $path) || die "trouble: $!";
  98     $c->response->content_type('text/html');
  99     $c->response->body($fh);
 100   }
 101
 102   # If you pull the file contents into a var, NOW you need to specify the
 103   # IO encoding on the FH.  Ultimately Plack at the end wants bytes...
 104   sub stream_body_fh2 :Local {
 105     my ($self, $c) = @_;
 106     my $path = File::Spec->catfile('t', 'utf8.txt');
 107     open(my $fh, '<:encoding(UTF-8)', $path) || die "trouble: $!";
 108     my $contents = do { local $/; <$fh> };
 109
 110     $c->response->content_type('text/html');
 111     $c->response->body($contents);
 112   }
 113
 114   sub write_then_body :Local {
 115     my ($self, $c) = @_;
 116
 117     $c->res->content_type('text/html');
 118     $c->res->write("<p>This is early_write action ♥</p>");
 119     $c->res->body("<p>This is body_write action ♥</p>");
 120   }
 121
 122   sub file_upload :POST  Consumes(Multipart) Local {
 123     my ($self, $c) = @_;
 124     Test::More::is $c->req->body_parameters->{'♥'}, '♥♥';
 125     Test::More::ok my $upload = $c->req->uploads->{file};
 126     Test::More::is $upload->charset, 'UTF-8';
 127
 128     my $text = $upload->slurp;
 129     Test::More::is Encode::decode_utf8($text), "<p>This is stream_body_fh action ♥</p>\n";
 130
 131     my $decoded_text = $upload->decoded_slurp;
 132     Test::More::is $decoded_text, "<p>This is stream_body_fh action ♥</p>\n";
 133
 134     Test::More::is $upload->filename, '♥ttachment.txt';
 135     Test::More::is $upload->raw_basename, '♥ttachment.txt';
 136
 137     $c->response->content_type('text/html');
 138     $c->response->body($decoded_text);
 139   }
 140
 141   sub json :POST Consumes(JSON) Local {
 142     my ($self, $c) = @_;
 143     my $post = $c->req->body_data;
 144
 145     Test::More::is $post->{'♥'}, '♥♥';
 146     Test::More::is length($post->{'♥'}), 2;
 147     $c->response->content_type('application/json');
 148
 149     # Encode JSON also encodes to a UTF-8 encoded, binary string. This is why we don't
 150     # have application/json as one of the things we match, otherwise we get double
 151     # encoding.
 152     $c->response->body(JSON::MaybeXS::encode_json($post));
 153   }
 154
 155   ## If someone clears encoding, they can do as they wish
 156   sub manual_1 :Local {
 157     my ($self, $c) = @_;
 158     $c->clear_encoding;
 159     $c->res->content_type('text/plain');
 160     $c->res->content_type_charset('UTF-8');
 161     $c->response->body( Encode::encode_utf8("manual_1 ♥"));
 162   }
 163
 164   ## If you do like gzip, well handle that yourself!  Basically if you do some sort
 165   ## of content encoding like gzip, you must do on top of the encoding.  We will fix
 166   ## the encoding plugins (Catalyst::Plugin::Compress) to do this properly for you.
 167   #
 168   sub gzipped :Local {
 169     require Compress::Zlib;
 170     my ($self, $c) = @_;
 171     $c->res->content_type('text/plain');
 172     $c->res->content_type_charset('UTF-8');
 173     $c->res->content_encoding('gzip');
 174     $c->response->body(Compress::Zlib::memGzip(Encode::encode_utf8("manual_1 ♥")));
 175   }
 176
 177   sub override_encoding :Local {
 178     my ($self, $c) = @_;
 179     $c->res->content_type('text/plain');
 180     $c->encoding(Encode::find_encoding('UTF-8'));
 181     $c->encoding(Encode::find_encoding('Shift_JIS'));
 182     $c->response->body("テスト");
 183   }
 184
 185   sub stream_write_error :Local {
 186     my ($self, $c) = @_;
 187     $c->response->content_type('text/html');
 188     $c->response->write("<p>This is stream_write action ♥</p>");
 189     $c->encoding(Encode::find_encoding('Shift_JIS'));
 190     $c->response->write("<p>This is stream_write action ♥</p>");
 191   }
 192
 193   sub from_external_psgi :Local {
 194     my ($self, $c) = @_;
 195     my $env = HTTP::Message::PSGI::req_to_psgi( HTTP::Request::Common::GET '/root/♥');
 196     $c->res->from_psgi_response( ref($c)->to_app->($env));
 197   }
 198
 199   sub echo_arg :Local {
 200     my ($self, $c) = @_;
 201     $c->response->content_type('text/plain');
 202     $c->response->body($c->req->body_parameters->{arg});
 203   }
 204
 205   package MyApp;
 206   use Catalyst;
 207
 208   Test::More::ok(MyApp->setup, 'setup app');
 209 }
 210
 211 ok my $psgi = MyApp->psgi_app, 'build psgi app';
 212
 213 use Catalyst::Test 'MyApp';
 214
 215 {
 216   my $res = request "/root/♥";
 217
 218   is $res->code, 200, 'OK';
 219   is decode_utf8($res->content), '<p>This is path-heart action ♥</p>', 'correct body';
 220   is $res->content_length, 36, 'correct length';
 221   is $res->content_charset, 'UTF-8';
 222 }
 223
 224 {
 225   my $res = request "/root/a♥/♥";
 226
 227   is $res->code, 200, 'OK';
 228   is decode_utf8($res->content), '<p>This is path-heart-arg action ♥</p>', 'correct body';
 229   is $res->content_length, 40, 'correct length';
 230   is $res->content_charset, 'UTF-8';
 231 }
 232
 233 {
 234   my $res = request "/root/^";
 235
 236   is $res->code, 200, 'OK';
 237   is decode_utf8($res->content), '<p>This is path-hat action ^</p>', 'correct body';
 238   is $res->content_length, 32, 'correct length';
 239   is $res->content_charset, 'UTF-8';
 240 }
 241
 242 {
 243   my $res = request "/base/♥";
 244
 245   is $res->code, 200, 'OK';
 246   is decode_utf8($res->content), '<p>This is base-link action ♥</p>', 'correct body';
 247   is $res->content_length, 35, 'correct length';
 248   is $res->content_charset, 'UTF-8';
 249 }
 250
 251 {
 252   my ($res, $c) = ctx_request POST "/base/♥?♥=♥&♥=♥♥", [a=>1, b=>'', '♥'=>'♥', '♥'=>'♥♥'];
 253
 254   is $res->code, 200, 'OK';
 255   is decode_utf8($res->content), '<p>This is base-link action ♥</p>', 'correct body';
 256   is $res->content_length, 35, 'correct length';
 257   is $c->req->parameters->{'♥'}[0], '♥';
 258   is $c->req->query_parameters->{'♥'}[0], '♥';
 259   is $c->req->body_parameters->{'♥'}[0], '♥';
 260   is $c->req->parameters->{'♥'}[0], '♥';
 261   is $c->req->parameters->{a}, 1;
 262   is $c->req->body_parameters->{a}, 1;
 263   is $res->content_charset, 'UTF-8';
 264 }
 265
 266 {
 267   my ($res, $c) = ctx_request GET "/base/♥?♥♥♥";
 268
 269   is $res->code, 200, 'OK';
 270   is decode_utf8($res->content), '<p>This is base-link action ♥</p>', 'correct body';
 271   is $res->content_length, 35, 'correct length';
 272   is $c->req->query_keywords, '♥♥♥';
 273   is $res->content_charset, 'UTF-8';
 274 }
 275
 276 {
 277   my $res = request "/base/♥/♥";
 278
 279   is $res->code, 200, 'OK';
 280   is decode_utf8($res->content), '<p>This is base-link action ♥ ♥</p>', 'correct body';
 281   is $res->content_length, 39, 'correct length';
 282   is $res->content_charset, 'UTF-8';
 283 }
 284
 285 {
 286   my $res = request "/base/♥/♥/♥/♥";
 287
 288   is decode_utf8($res->content), '<p>This is base-link action ♥ ♥</p>', 'correct body';
 289   is $res->content_length, 39, 'correct length';
 290   is $res->content_charset, 'UTF-8';
 291 }
 292
 293 {
 294   my ($res, $c) = ctx_request POST "/base/♥/♥/♥/♥?♥=♥♥", [a=>1, b=>'2', '♥'=>'♥♥'];
 295
 296   ## Make sure that the urls we generate work the same
 297   my $uri_for1 = $c->uri_for($c->controller('Root')->action_for('argend'), ['♥'], '♥', {'♥'=>'♥♥'});
 298   my $uri_for2 = $c->uri_for($c->controller('Root')->action_for('argend'), ['♥', '♥'], {'♥'=>'♥♥'});
 299   my $uri = $c->req->uri;
 300
 301   is "$uri_for1", "$uri_for2";
 302   is "$uri", "$uri_for1";
 303
 304   {
 305     my ($res, $c) = ctx_request POST "$uri_for1", [a=>1, b=>'2', '♥'=>'♥♥'];
 306     is $c->req->query_parameters->{'♥'}, '♥♥';
 307     is $c->req->body_parameters->{'♥'}, '♥♥';
 308     is $c->req->parameters->{'♥'}[0], '♥♥'; #combined with query and body
 309     is $c->req->args->[0], '♥';
 310     is length($c->req->parameters->{'♥'}[0]), 2;
 311     is length($c->req->query_parameters->{'♥'}), 2;
 312     is length($c->req->body_parameters->{'♥'}), 2;
 313     is length($c->req->args->[0]), 1;
 314     is $res->content_charset, 'UTF-8';
 315   }
 316 }
 317
 318 {
 319   my ($res, $c) = ctx_request "/root/uri_for";
 320   my $url = $c->uri_for($c->controller('Root')->action_for('argend'), ['♥'], '♥', {'♥'=>'♥♥'});
 321
 322   is $res->code, 200, 'OK';
 323   is decode_utf8($res->content), "$url", 'correct body'; #should do nothing
 324   is $res->content, "$url", 'correct body';
 325   is $res->content_length, 90, 'correct length';
 326   is $res->content_charset, 'UTF-8';
 327
 328   {
 329     my $url = $c->uri_for($c->controller->action_for('heart_with_arg'), '♥');
 330     is "$url", 'http://localhost/root/a%E2%99%A5/%E2%99%A5', "correct $url";
 331   }
 332
 333   {
 334     my $url = $c->uri_for($c->controller->action_for('heart_with_arg'), ['♥']);
 335     is "$url", 'http://localhost/root/a%E2%99%A5/%E2%99%A5', "correct $url";
 336   }
 337 }
 338
 339 {
 340   my $res = request "/root/stream_write";
 341
 342   is $res->code, 200, 'OK GET /root/stream_write';
 343   is decode_utf8($res->content), '<p>This is stream_write action ♥</p>', 'correct body';
 344   is $res->content_charset, 'UTF-8';
 345 }
 346
 347 {
 348   my $res = request "/root/stream_body_fh";
 349
 350   is $res->code, 200, 'OK';
 351   is decode_utf8($res->content), "<p>This is stream_body_fh action ♥</p>\n", 'correct body';
 352   is $res->content_charset, 'UTF-8';
 353   # Not sure why there is a trailing newline above... its not in catalyst code I can see. Not sure
 354   # if is a problem or just an artifact of the why the test stuff works - JNAP
 355 }
 356
 357 {
 358   my $res = request "/root/stream_write_fh";
 359
 360   is $res->code, 200, 'OK';
 361   is decode_utf8($res->content), '<p>This is stream_write_fh action ♥</p>', 'correct body';
 362   #is $res->content_length, 41, 'correct length';
 363   is $res->content_charset, 'UTF-8';
 364 }
 365
 366 {
 367   my $res = request "/root/stream_body_fh2";
 368
 369   is $res->code, 200, 'OK';
 370   is decode_utf8($res->content), "<p>This is stream_body_fh action ♥</p>\n", 'correct body';
 371   is $res->content_length, 41, 'correct length';
 372   is $res->content_charset, 'UTF-8';
 373 }
 374
 375 {
 376   my $res = request "/root/write_then_body";
 377
 378   is $res->code, 200, 'OK';
 379   is decode_utf8($res->content), "<p>This is early_write action ♥</p><p>This is body_write action ♥</p>";
 380   is $res->content_charset, 'UTF-8';
 381 }
 382
 383 {
 384   ok my $path = File::Spec->catfile('t', 'utf8.txt');
 385   ok my $req = POST '/root/file_upload',
 386     Content_Type => 'form-data',
 387     Content =>  [encode_utf8('♥')=>encode_utf8('♥♥'), file=>["$path", encode_utf8('♥ttachment.txt'), 'Content-Type' =>'text/html; charset=UTF-8', ]];
 388
 389   ok my $res = request $req;
 390   is decode_utf8($res->content), "<p>This is stream_body_fh action ♥</p>\n";
 391 }
 392
 393 {
 394   ok my $req = POST '/root/json',
 395      Content_Type => 'application/json',
 396      Content => encode_json +{'♥'=>'♥♥'}; # Note: JSON does the UTF* encoding for us
 397
 398   ok my $res = request $req;
 399
 400   ## decode_json expect the binary utf8 string and does the decoded bit for us.
 401   is_deeply decode_json(($res->content)), +{'♥'=>'♥♥'}, 'JSON was decoded correctly';
 402 }
 403
 404 {
 405   ok my $res = request "/root/override_encoding";
 406   ok my $enc = Encode::find_encoding('SHIFT_JIS');
 407
 408   is $res->code, 200, 'OK';
 409   is $enc->decode($res->content), "テスト", 'correct body';
 410   is $res->content_length, 6, 'correct length'; # Bytes over the wire
 411   is length($enc->decode($res->content)), 3;
 412   is $res->content_charset, 'SHIFT_JIS', 'content charset is SHIFT_JIS as expected';
 413 }
 414
 415 {
 416   my $res = request "/root/manual_1";
 417
 418   is $res->code, 200, 'OK';
 419   is decode_utf8($res->content), "manual_1 ♥", 'correct body';
 420   is $res->content_length, 12, 'correct length';
 421   is $res->content_charset, 'UTF-8';
 422 }
 423
 424 SKIP: {
 425   eval { require Compress::Zlib; 1} || do {
 426     skip "Compress::Zlib needed to test gzip encoding", 5 };
 427
 428   my $res = request "/root/gzipped";
 429   ok my $raw_content = $res->content;
 430   ok my $content = Compress::Zlib::memGunzip($raw_content), 'no gunzip error';
 431
 432   is $res->code, 200, 'OK';
 433   is decode_utf8($content), "manual_1 ♥", 'correct body';
 434   is $res->content_charset, 'UTF-8', 'zlib charset is set correctly';
 435 }
 436
 437 {
 438   my $res = request "/root/stream_write_error";
 439
 440   is $res->code, 200, 'OK';
 441   like decode_utf8($res->content), qr[<p>This is stream_write action ♥</p><!DOCTYPE html], 'correct body';
 442 }
 443
 444 {
 445   my $res = request "/root/from_external_psgi";
 446
 447   is $res->code, 200, 'OK';
 448   is decode_utf8($res->content), '<p>This is path-heart action ♥</p>', 'correct body';
 449   is $res->content_length, 36, 'correct length';
 450   is $res->content_charset, 'UTF-8', 'external PSGI app has expected charset';
 451 }
 452
 453 {
 454   my $utf8 = 'test ♥';
 455   my $shiftjs = 'test テスト';
 456
 457   ok my $req = POST '/root/echo_arg',
 458     Content_Type => 'form-data',
 459       Content =>  [
 460         arg0 => 'helloworld',
 461         Encode::encode('UTF-8','♥') => Encode::encode('UTF-8','♥♥'),  # Long form POST simple does not auto encode...
 462         Encode::encode('UTF-8','♥♥♥') => [
 463           undef, '',
 464           'Content-Type' =>'text/plain; charset=SHIFT_JIS',
 465           'Content' => Encode::encode('SHIFT_JIS', $shiftjs)],
 466         arg1 => [
 467           undef, '',
 468           'Content-Type' =>'text/plain; charset=UTF-8',
 469           'Content' => Encode::encode('UTF-8', $utf8)],
 470         arg2 => [
 471           undef, '',
 472           'Content-Type' =>'text/plain; charset=SHIFT_JIS',
 473           'Content' => Encode::encode('SHIFT_JIS', $shiftjs)],
 474         arg2 => [
 475           undef, '',
 476           'Content-Type' =>'text/plain; charset=SHIFT_JIS',
 477           'Content' => Encode::encode('SHIFT_JIS', $shiftjs)],
 478       ];
 479
 480   my ($res, $c) = ctx_request $req;
 481
 482   is $c->req->body_parameters->{'arg0'}, 'helloworld', 'got helloworld value';
 483   is $c->req->body_parameters->{'♥'}, '♥♥';
 484
 485   ok Scalar::Util::blessed($c->req->body_parameters->{'arg1'});
 486   ok Scalar::Util::blessed($c->req->body_parameters->{'arg2'}[0]);
 487   ok Scalar::Util::blessed($c->req->body_parameters->{'arg2'}[1]);
 488   ok Scalar::Util::blessed($c->req->body_parameters->{'♥♥♥'});
 489
 490   # Since the form post is COMPLEX you are expected to decode it yourself.
 491   is Encode::decode('UTF-8', $c->req->body_parameters->{'arg1'}->raw_data), $utf8, 'decoded utf8 param';
 492   is Encode::decode('SHIFT_JIS', $c->req->body_parameters->{'arg2'}[0]->raw_data), $shiftjs, 'decoded shiftjis param';
 493   is Encode::decode('SHIFT_JIS', $c->req->body_parameters->{'arg2'}[1]->raw_data), $shiftjs, 'decoded shiftjis param';
 494   is Encode::decode('SHIFT_JIS', $c->req->body_parameters->{'♥♥♥'}->raw_data), $shiftjs, 'decoded shiftjis param';
 495
 496 }
 497
 498 {
 499   my $shiftjs = 'test テスト';
 500   my $encoded = Encode::encode('UTF-8', $shiftjs);
 501
 502   ok my $req = GET "/root/echo_arg?a=$encoded";
 503   my ($res, $c) = ctx_request $req;
 504
 505   is $c->req->query_parameters->{'a'}, $shiftjs, 'got expected value';
 506 }
 507
 508 ## should we use binmode on filehandles to force the encoding...?
 509 ## Not sure what else to do with multipart here, if docs are enough...
 510
 511 done_testing;