[prev in list] [next in list] [prev in thread] [next in thread] 

List:       apache-modperl-cvs
Subject:    cvs commit: modperl-2.0/t/response/TestModperl post_utf8.pm
From:       stas () apache ! org
Date:       2003-09-22 23:59:14
[Download RAW message or body]

stas        2003/09/22 16:59:14

  Added:       t/modperl post_utf8.t
               t/response/TestModperl post_utf8.pm
  Log:
  add utf8 POST tests
  
  Revision  Changes    Path
  1.1                  modperl-2.0/t/modperl/post_utf8.t
  
  Index: post_utf8.t
  ===================================================================
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::TestRequest;
  
  my $location = "/TestModperl__post_utf8";
  
  # From A.S.Pushkin's "Evgeniy Onegin"
  my $data_ascii = "I love you, (why lying?), but I belong to another";
  my $data_utf8  = "\x{042F} \x{0432}\x{0430}\x{0441} \x{043B}\x{044E}" .
      "\x{0431}\x{043B}\x{044E} (\x{043A} \x{0447}\x{0435}\x{043C}\x{0443} " .
      "\x{043B}\x{0443}\x{043A}\x{0430}\x{0432}\x{0438}\x{0442}\x{044C}?),\n" .
      "\x{041D}\x{043E} \x{044F} \x{0434}\x{0440}\x{0443}\x{0433}\x{043E}" .
      "\x{043C}\x{0443} \x{043E}\x{0442}\x{0434}\x{0430}\x{043D}\x{0430};";
  
  my $data = join '=', $data_ascii, $data_utf8;
  
  # must encode the utf8 request body
  # we will skip the response any way if perl < 5.008
  utf8::encode($data) if $] >= 5.008;
  
  print POST_BODY_ASSERT $location, content => $data,
      'Accept-Charset'  => "ISO-8859-1,UTF-8";
  
  
  
  
  
  1.1                  modperl-2.0/t/response/TestModperl/post_utf8.pm
  
  Index: post_utf8.pm
  ===================================================================
  package TestModperl::post_utf8;
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  use Apache::TestUtil;
  use Apache::TestTrace;
  
  use Apache::RequestRec ();
  use Apache::RequestIO ();
  use APR::Table ();
  
  use Apache::Const -compile => 'OK';
  
  my $expected_ascii = "I love you, (why lying?), but I belong to another";
  my $expected_utf8  = "\x{042F} \x{0432}\x{0430}\x{0441} \x{043B}\x{044E}" .
      "\x{0431}\x{043B}\x{044E} (\x{043A} \x{0447}\x{0435}\x{043C}\x{0443} " .
      "\x{043B}\x{0443}\x{043A}\x{0430}\x{0432}\x{0438}\x{0442}\x{044C}?),\n" .
      "\x{041D}\x{043E} \x{044F} \x{0434}\x{0440}\x{0443}\x{0433}\x{043E}" .
      "\x{043C}\x{0443} \x{043E}\x{0442}\x{0434}\x{0430}\x{043D}\x{0430};";
  
  sub handler {
      my $r = shift;
  
  #    # visual debug, e.g. in lynx/mozilla
  #    $r->content_type("text/plain; charset=utf-8");
  #    $r->print("expected: $expected_utf8\n");
  
      # utf encode/decode was added only in 5.8.0
      # XXX: currently binmode is only available with perlio (used on the
      # server side on the tied/perlio STDOUT)
      plan $r, tests => 2, 
          have have_min_perl_version(5.008), have_perl('perlio');
  
      my $received = ModPerl::Test::read_post($r) || "";
      utf8::decode($received)
            if ($r->headers_in->{'Accept-Charset'}||'') =~ /utf-8/i;
      my ($received_ascii, $received_utf8) = split /=/, $received;
  
      ok t_cmp($expected_ascii, $received_ascii, "ascii");
  
      ok $expected_utf8 eq $received_utf8;
      # if you want to see the utf8 data run with:
      # t/TEST -trace=debug -v modperl/post_utf8
      # and look for this data in t/logs/error_log
      # needed for sending utf-8 to STDERR for debug
      binmode(STDERR, ':utf8');
      debug "expected: $expected_utf8";
      debug "received: $received_utf8";
  
      Apache::OK;
  }
  
  1;
  __END__
  SetHandler perl-script
  
  
  
[prev in list] [next in list] [prev in thread] [next in thread]