t/unicode-exception-bug.t

   1 use strict;
   2 use warnings;
   3 use Test::More;
   4
   5 BEGIN {
   6   package TestApp::Exception;
   7   $INC{'TestApp/Exception.pm'} = __FILE__;
   8
   9   sub new {
  10     my ($class, $code, $headers, $body) = @_;
  11     return bless +{res => [$code, $headers, $body]}, $class;
  12   }
  13
  14   sub throw { die shift->new(@_) }
  15
  16   sub as_psgi {
  17     my ($self, $env) = @_;
  18     my ($code, $headers, $body) = @{$self->{res}};
  19
  20     return [$code, $headers, $body]; # for now
  21
  22     return sub {
  23       my $responder = shift;
  24       $responder->([$code, $headers, $body]);
  25     };
  26   }
  27
  28   package TestApp::Controller::Root;
  29   $INC{'TestApp/Controller/Root.pm'} = __FILE__;
  30
  31   use Moose;
  32   use MooseX::MethodAttributes;
  33   extends 'Catalyst::Controller';
  34
  35   sub main :Path('') :Args(1) {
  36     my ($self, $c, $arg) = @_;
  37     $c->res->body('<h1>OK</h1>');
  38     $c->res->content_type('text/html');
  39   }
  40
  41   TestApp::Controller::Root->config(namespace => '');
  42 }
  43
  44 {
  45   package TestApp;
  46   $INC{'TestApp.pm'} = __FILE__;
  47
  48   use Catalyst;
  49   use TestApp::Exception;
  50
  51   sub handle_unicode_encoding_exception {
  52     my ( $self, $param_value, $error_msg ) = @_;
  53     TestApp::Exception->throw(
  54       200, ['content-type'=>'text/plain'], ['Bad unicode data']);
  55   }
  56
  57   __PACKAGE__->setup;
  58 }
  59
  60
  61 use Catalyst::Test 'TestApp';
  62
  63 {
  64   my $res = request('/ok');
  65   is ($res->status_line, "200 OK");
  66   is ($res->content, '<h1>OK</h1>');
  67 }
  68
  69 {
  70   my $res = request('/%E2%C3%83%C6%92%C3%8');
  71   is ($res->content, 'Bad unicode data');
  72 }
  73
  74 done_testing;
  75
  76 #TestApp->to_app;