t/utf_incoming.t

   1 use utf8;
   2 use warnings;
   3 use strict;
   4 use Test::More;
   5 use HTTP::Request::Common;
   6 use Encode 2.21 'decode_utf8', 'encode_utf8';
   7 use File::Spec;
   8 use JSON::MaybeXS;
   9
  10 # Test cases for incoming utf8
  11
  12 {
  13   package MyApp::Controller::Root;
  14   $INC{'MyApp/Controller/Root.pm'} = __FILE__;
  15
  16   use base 'Catalyst::Controller';
  17
  18   sub heart :Path('♥') {
  19     my ($self, $c) = @_;
  20     $c->response->content_type('text/html');
  21     $c->response->body("<p>This is path-heart action ♥</p>");
  22     # We let the content length middleware find the length...
  23   }
  24
  25   sub hat :Path('^') {
  26     my ($self, $c) = @_;
  27     $c->response->content_type('text/html');
  28     $c->response->body("<p>This is path-hat action ^</p>");
  29   }
  30
  31   sub uri_for :Path('uri_for') {
  32     my ($self, $c) = @_;
  33     $c->response->content_type('text/html');
  34     $c->response->body("${\$c->uri_for($c->controller('Root')->action_for('argend'), ['♥'], '♥', {'♥'=>'♥♥'})}");
  35   }
  36
  37   sub heart_with_arg :Path('a♥') Args(1)  {
  38     my ($self, $c, $arg) = @_;
  39     $c->response->content_type('text/html');
  40     $c->response->body("<p>This is path-heart-arg action $arg</p>");
  41     Test::More::is $c->req->args->[0], '♥';
  42   }
  43
  44   sub base :Chained('/') CaptureArgs(0) { }
  45     sub link :Chained('base') PathPart('♥') Args(0) {
  46       my ($self, $c) = @_;
  47       $c->response->content_type('text/html');
  48       $c->response->body("<p>This is base-link action ♥</p>");
  49     }
  50     sub arg :Chained('base') PathPart('♥') Args(1) {
  51       my ($self, $c, $arg) = @_;
  52       $c->response->content_type('text/html');
  53       $c->response->body("<p>This is base-link action ♥ $arg</p>");
  54     }
  55     sub capture :Chained('base') PathPart('♥') CaptureArgs(1) {
  56       my ($self, $c, $arg) = @_;
  57       $c->stash(capture=>$arg);
  58     }
  59       sub argend :Chained('capture') PathPart('♥') Args(1) {
  60         my ($self, $c, $arg) = @_;
  61         $c->response->content_type('text/html');
  62
  63         Test::More::is $c->req->args->[0], '♥';
  64         Test::More::is $c->req->captures->[0], '♥';
  65
  66         $c->response->body("<p>This is base-link action ♥ ${\$c->req->args->[0]}</p>");
  67
  68         # Test to make sure redirect can now take an object (sorry don't have a better place for it
  69         # but wanted test coverage.
  70         my $location = $c->res->redirect( $c->uri_for($c->controller('Root')->action_for('uri_for')) );
  71         Test::More::ok !ref $location;
  72       }
  73
  74   sub stream_write :Local {
  75     my ($self, $c) = @_;
  76     $c->response->content_type('text/html');
  77     $c->response->write("<p>This is stream_write action ♥</p>");
  78   }
  79
  80   sub stream_write_fh :Local {
  81     my ($self, $c) = @_;
  82     $c->response->content_type('text/html');
  83
  84     my $writer = $c->res->write_fh;
  85     $writer->write_encoded('<p>This is stream_write_fh action ♥</p>');
  86     $writer->close;
  87   }
  88
  89   # Stream a file with utf8 chars directly, you don't need to decode
  90   sub stream_body_fh :Local {
  91     my ($self, $c) = @_;
  92     my $path = File::Spec->catfile('t', 'utf8.txt');
  93     open(my $fh, '<', $path) || die "trouble: $!";
  94     $c->response->content_type('text/html');
  95     $c->response->body($fh);
  96   }
  97
  98   # If you pull the file contents into a var, NOW you need to specify the
  99   # IO encoding on the FH.  Ultimately Plack at the end wants bytes...
 100   sub stream_body_fh2 :Local {
 101     my ($self, $c) = @_;
 102     my $path = File::Spec->catfile('t', 'utf8.txt');
 103     open(my $fh, '<:encoding(UTF-8)', $path) || die "trouble: $!";
 104     my $contents = do { local $/; <$fh> };
 105
 106     $c->response->content_type('text/html');
 107     $c->response->body($contents);
 108   }
 109
 110   sub file_upload :POST  Consumes(Multipart) Local {
 111     my ($self, $c) = @_;
 112     Test::More::is $c->req->body_parameters->{'♥'}, '♥♥';
 113     Test::More::ok my $upload = $c->req->uploads->{file};
 114     Test::More::is $upload->charset, 'UTF-8';
 115
 116     my $text = $upload->slurp;
 117     Test::More::is Encode::decode_utf8($text), "<p>This is stream_body_fh action ♥</p>\n";
 118
 119     my $decoded_text = $upload->decoded_slurp;
 120     Test::More::is $decoded_text, "<p>This is stream_body_fh action ♥</p>\n";
 121
 122     Test::More::is $upload->filename, '♥ttachment.txt';
 123     Test::More::is $upload->raw_basename, '♥ttachment.txt';
 124
 125     $c->response->content_type('text/html');
 126     $c->response->body($decoded_text);
 127   }
 128
 129   sub json :POST Consumes(JSON) Local {
 130     my ($self, $c) = @_;
 131     my $post = $c->req->body_data;
 132
 133     Test::More::is $post->{'♥'}, '♥♥';
 134     $c->response->content_type('application/json');
 135
 136     # Encode JSON also encodes to a UTF-8 encoded, binary string. This is why we don't
 137     # have application/json as one of the things we match, otherwise we get double
 138     # encoding.
 139     $c->response->body(JSON::MaybeXS::encode_json($post));
 140   }
 141
 142   ## If someone clears encoding, they can do as they wish
 143   sub manual_1 :Local {
 144     my ($self, $c) = @_;
 145     $c->encoding(undef);
 146     $c->res->content_type('text/plain');
 147     $c->res->content_type_charset('UTF-8');
 148     $c->response->body( Encode::encode_utf8("manual_1 ♥"));
 149   }
 150
 151   ## If you do like gzip, well handle that yourself!  Basically if you do some sort
 152   ## of content encoding like gzip, you must do on top of the encoding.  We will fix
 153   ## the encoding plugins (Catalyst::Plugin::Compress) to do this properly for you.
 154   #
 155   sub gzipped :Local {
 156     require Compress::Zlib;
 157     my ($self, $c) = @_;
 158     $c->res->content_type('text/plain');
 159     $c->res->content_type_charset('UTF-8');
 160     $c->res->content_encoding('gzip');
 161     $c->response->body(Compress::Zlib::memGzip(Encode::encode_utf8("manual_1 ♥")));
 162   }
 163
 164   package MyApp;
 165   use Catalyst;
 166
 167   # Default encoding is now UTF-8
 168   # MyApp->config(encoding=>'UTF-8');
 169
 170   Test::More::ok(MyApp->setup, 'setup app');
 171 }
 172
 173 ok my $psgi = MyApp->psgi_app, 'build psgi app';
 174
 175 use Catalyst::Test 'MyApp';
 176
 177 {
 178   my $res = request "/root/♥";
 179
 180   is $res->code, 200, 'OK';
 181   is decode_utf8($res->content), '<p>This is path-heart action ♥</p>', 'correct body';
 182   is $res->content_length, 36, 'correct length';
 183   is $res->content_charset, 'UTF-8';
 184 }
 185
 186 {
 187   my $res = request "/root/a♥/♥";
 188
 189   is $res->code, 200, 'OK';
 190   is decode_utf8($res->content), '<p>This is path-heart-arg action ♥</p>', 'correct body';
 191   is $res->content_length, 40, 'correct length';
 192   is $res->content_charset, 'UTF-8';
 193 }
 194
 195 {
 196   my $res = request "/root/^";
 197
 198   is $res->code, 200, 'OK';
 199   is decode_utf8($res->content), '<p>This is path-hat action ^</p>', 'correct body';
 200   is $res->content_length, 32, 'correct length';
 201   is $res->content_charset, 'UTF-8';
 202 }
 203
 204 {
 205   my $res = request "/base/♥";
 206
 207   is $res->code, 200, 'OK';
 208   is decode_utf8($res->content), '<p>This is base-link action ♥</p>', 'correct body';
 209   is $res->content_length, 35, 'correct length';
 210   is $res->content_charset, 'UTF-8';
 211 }
 212
 213 {
 214   my ($res, $c) = ctx_request POST "/base/♥?♥=♥&♥=♥♥", [a=>1, b=>'', '♥'=>'♥', '♥'=>'♥♥'];
 215
 216   is $res->code, 200, 'OK';
 217   is decode_utf8($res->content), '<p>This is base-link action ♥</p>', 'correct body';
 218   is $res->content_length, 35, 'correct length';
 219   is $c->req->parameters->{'♥'}[0], '♥';
 220   is $c->req->query_parameters->{'♥'}[0], '♥';
 221   is $c->req->body_parameters->{'♥'}[0], '♥';
 222   is $c->req->parameters->{'♥'}[0], '♥';
 223   is $c->req->parameters->{a}, 1;
 224   is $c->req->body_parameters->{a}, 1;
 225   is $res->content_charset, 'UTF-8';
 226 }
 227
 228 {
 229   my ($res, $c) = ctx_request GET "/base/♥?♥♥♥";
 230
 231   is $res->code, 200, 'OK';
 232   is decode_utf8($res->content), '<p>This is base-link action ♥</p>', 'correct body';
 233   is $res->content_length, 35, 'correct length';
 234   is $c->req->query_keywords, '♥♥♥';
 235   is $res->content_charset, 'UTF-8';
 236 }
 237
 238 {
 239   my $res = request "/base/♥/♥";
 240
 241   is $res->code, 200, 'OK';
 242   is decode_utf8($res->content), '<p>This is base-link action ♥ ♥</p>', 'correct body';
 243   is $res->content_length, 39, 'correct length';
 244   is $res->content_charset, 'UTF-8';
 245 }
 246
 247 {
 248   my $res = request "/base/♥/♥/♥/♥";
 249
 250   is decode_utf8($res->content), '<p>This is base-link action ♥ ♥</p>', 'correct body';
 251   is $res->content_length, 39, 'correct length';
 252   is $res->content_charset, 'UTF-8';
 253 }
 254
 255 {
 256   my ($res, $c) = ctx_request POST "/base/♥/♥/♥/♥?♥=♥♥", [a=>1, b=>'2', '♥'=>'♥♥'];
 257
 258   ## Make sure that the urls we generate work the same
 259   my $uri_for1 = $c->uri_for($c->controller('Root')->action_for('argend'), ['♥'], '♥', {'♥'=>'♥♥'});
 260   my $uri_for2 = $c->uri_for($c->controller('Root')->action_for('argend'), ['♥', '♥'], {'♥'=>'♥♥'});
 261   my $uri = $c->req->uri;
 262
 263   is "$uri_for1", "$uri_for2";
 264   is "$uri", "$uri_for1";
 265
 266   {
 267     my ($res, $c) = ctx_request POST "$uri_for1", [a=>1, b=>'2', '♥'=>'♥♥'];
 268     is $c->req->query_parameters->{'♥'}, '♥♥';
 269     is $c->req->body_parameters->{'♥'}, '♥♥';
 270     is $c->req->parameters->{'♥'}[0], '♥♥'; #combined with query and body
 271     is $res->content_charset, 'UTF-8';
 272   }
 273 }
 274
 275 {
 276   my ($res, $c) = ctx_request "/root/uri_for";
 277   my $url = $c->uri_for($c->controller('Root')->action_for('argend'), ['♥'], '♥', {'♥'=>'♥♥'});
 278
 279   is $res->code, 200, 'OK';
 280   is decode_utf8($res->content), "$url", 'correct body'; #should do nothing
 281   is $res->content, "$url", 'correct body';
 282   is $res->content_length, 90, 'correct length';
 283   is $res->content_charset, 'UTF-8';
 284
 285   {
 286     my $url = $c->uri_for($c->controller->action_for('heart_with_arg'), '♥');
 287     is "$url", 'http://localhost/root/a%E2%99%A5/%E2%99%A5', "correct $url";
 288   }
 289
 290   {
 291     my $url = $c->uri_for($c->controller->action_for('heart_with_arg'), ['♥']);
 292     is "$url", 'http://localhost/root/a%E2%99%A5/%E2%99%A5', "correct $url";
 293   }
 294 }
 295
 296 {
 297   my $res = request "/root/stream_write";
 298
 299   is $res->code, 200, 'OK GET /root/stream_write';
 300   is decode_utf8($res->content), '<p>This is stream_write action ♥</p>', 'correct body';
 301   is $res->content_charset, 'UTF-8';
 302 }
 303
 304 {
 305   my $res = request "/root/stream_body_fh";
 306
 307   is $res->code, 200, 'OK';
 308   is decode_utf8($res->content), "<p>This is stream_body_fh action ♥</p>\n", 'correct body';
 309   is $res->content_charset, 'UTF-8';
 310   # Not sure why there is a trailing newline above... its not in catalyst code I can see. Not sure
 311   # if is a problem or just an artifact of the why the test stuff works - JNAP
 312 }
 313
 314 {
 315   my $res = request "/root/stream_write_fh";
 316
 317   is $res->code, 200, 'OK';
 318   is decode_utf8($res->content), '<p>This is stream_write_fh action ♥</p>', 'correct body';
 319   #is $res->content_length, 41, 'correct length';
 320   is $res->content_charset, 'UTF-8';
 321 }
 322
 323 {
 324   my $res = request "/root/stream_body_fh2";
 325
 326   is $res->code, 200, 'OK';
 327   is decode_utf8($res->content), "<p>This is stream_body_fh action ♥</p>\n", 'correct body';
 328   is $res->content_length, 41, 'correct length';
 329   is $res->content_charset, 'UTF-8';
 330 }
 331
 332 {
 333   ok my $path = File::Spec->catfile('t', 'utf8.txt');
 334   ok my $req = POST '/root/file_upload',
 335     Content_Type => 'form-data',
 336     Content =>  [encode_utf8('♥')=>encode_utf8('♥♥'), file=>["$path", encode_utf8('♥ttachment.txt'), 'Content-Type' =>'text/html; charset=UTF-8', ]];
 337
 338   ok my $res = request $req;
 339   is decode_utf8($res->content), "<p>This is stream_body_fh action ♥</p>\n";
 340 }
 341
 342 {
 343   ok my $req = POST '/root/json',
 344      Content_Type => 'application/json',
 345      Content => encode_json +{'♥'=>'♥♥'}; # Note: JSON does the UTF* encoding for us
 346
 347   ok my $res = request $req;
 348
 349   ## decode_json expect the binary utf8 string and does the decoded bit for us.
 350   is_deeply decode_json(($res->content)), +{'♥'=>'♥♥'};
 351 }
 352
 353 {
 354   my $res = request "/root/manual_1";
 355
 356   is $res->code, 200, 'OK';
 357   is decode_utf8($res->content), "manual_1 ♥", 'correct body';
 358   is $res->content_length, 12, 'correct length';
 359   is $res->content_charset, 'UTF-8';
 360 }
 361
 362 SKIP: {
 363   eval { require Compress::Zlib; 1} || do {
 364     skip "Compress::Zlib needed to test gzip encoding", 5 };
 365
 366   my $res = request "/root/gzipped";
 367   ok my $raw_content = $res->content;
 368   ok my $content = Compress::Zlib::memGunzip($raw_content), 'no gunzip error';
 369
 370   is $res->code, 200, 'OK';
 371   is decode_utf8($content), "manual_1 ♥", 'correct body';
 372   is $res->content_charset, 'UTF-8';
 373 }
 374
 375 ## should we use binmode on filehandles to force the encoding...?
 376 ## Not sure what else to do with multipart here, if docs are enough...
 377
 378 done_testing;