t/lib/TestAppUnicode/Controller/Root.pm

   1 package TestAppUnicode::Controller::Root;
   2 use strict;
   3 use warnings;
   4 use utf8;
   5
   6 __PACKAGE__->config(namespace => q{});
   7
   8 use base 'Catalyst::Controller';
   9
  10 sub main :Path('') {
  11     my ($self, $ctx, $charset) = @_;
  12     my $content_type = 'text/html';
  13     if ($ctx->stash->{charset}) {
  14         $content_type .= ";charset=" . $ctx->stash->{charset};
  15     }
  16     $ctx->res->body('<h1>It works</h1>');
  17     $ctx->res->content_type($content_type);
  18 }
  19
  20 sub unicode_no_enc :Local {
  21     my ($self, $c) = @_;
  22     my $data = "ほげ"; # hoge!
  23     utf8::encode($data);
  24     $c->response->body($data);
  25     $c->res->content_type('text/plain');
  26     $c->encoding(undef);
  27 }
  28
  29 sub unicode :Local {
  30     my ($self, $c) = @_;
  31     my $data = "ほげ"; # hoge!
  32     $c->response->body($data); # should be decoded
  33     $c->res->content_type('text/plain');
  34 }
  35
  36 sub not_unicode :Local {
  37     my ($self, $c) = @_;
  38     my $data = "\x{1234}\x{5678}";
  39     utf8::encode($data); # DO NOT WANT unicode
  40     $c->response->body($data); # just some octets
  41     $c->res->content_type('text/plain');
  42     $c->encoding(undef);
  43 }
  44
  45 sub latin1 :Local {
  46   my ($self, $c) = @_;
  47
  48   $c->res->content_type('text/plain');
  49   $c->response->body('LATIN SMALL LETTER E WITH ACUTE: é');
  50 }
  51
  52 sub file :Local {
  53     my ($self, $c) = @_;
  54     close *STDERR; # i am evil.
  55     $c->response->body($main::TEST_FILE); # filehandle from test file
  56 }
  57
  58 sub capture : Chained('/') CaptureArgs(1) {}
  59
  60 sub decode_capture : Chained('capture') PathPart('') Args(0) {
  61     my ( $self, $c, $cap_arg ) = @_;
  62     $c->forward('main');
  63 }
  64
  65 sub capture_charset : Chained('/') Args(1) {
  66     my ( $self, $c, $cap_arg ) = @_;
  67     $c->stash(charset => $cap_arg);
  68     $c->forward('main');
  69 }
  70
  71 sub shift_jis :Local {
  72     my ($self, $c) = @_;
  73     my $data = "ほげ"; # hoge!
  74     $c->response->body($data); # should be decoded
  75     $c->res->content_type('text/plain; charset=Shift_JIS');
  76     $c->encoding("Shift_JIS");
  77 }
  78
  79 1;
  80