use strict; use warnings; use Test::More; use DBI; use Encode; use vars qw($test_dsn $test_user $test_password); use lib 't', '.'; require "lib.pl"; my $tb = Test::More->builder; binmode $tb->output, ":utf8"; binmode $tb->failure_output, ":utf8"; binmode $tb->todo_output, ":utf8"; sub skip_rt_102404 { skip "(Perl 5.13.1 and DBI 1.635) or DBI 1.639 is required due to bug RT 102404", $_[0] unless ($] >= 5.013001 and eval { DBI->VERSION(1.635) }) or eval { DBI->VERSION(1.639) }; } my $dbh = DbiTestConnect($test_dsn, $test_user, $test_password, { PrintError => 0, RaiseError => 1 }); eval { $dbh->do("SET lc_messages = 'ja_JP'"); } or do { $dbh->disconnect(); plan skip_all => "Server lc_messages ja_JP are needed for this test"; }; plan tests => 21; my $jpnTable = "\N{U+8868}"; # Japanese table my $jpnGender = "\N{U+6027}\N{U+5225}"; # Japanese word "gender" my $jpnYamadaTaro = "\N{U+5c71}\N{U+7530}\N{U+592a}\N{U+90ce}"; # a Japanese person name my $jpnMale = "\N{U+7537}"; # Japanese word "male" my $jpnErr = qr/\x{4ed8}\x{8fd1}.*\x{884c}\x{76ee}/; # Use \x{...} instead \N{U+...} due to Perl 5.12.0 bug my $sth; my $row; ok($dbh->do(" CREATE TEMPORARY TABLE $jpnTable ( name VARCHAR(20), $jpnGender CHAR(1) ) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_bin ")); ok($sth = $dbh->prepare("INSERT INTO $jpnTable (name, $jpnGender) VALUES (?, ?)")); ok($sth->execute($jpnYamadaTaro, $jpnMale)); ok($sth = $dbh->prepare("SELECT * FROM $jpnTable")); ok($sth->execute()); ok($row = $sth->fetchrow_hashref()); is($row->{name}, $jpnYamadaTaro); is($row->{$jpnGender}, $jpnMale); ok(!exists $row->{Encode::encode("UTF-8", $jpnGender)}); is_deeply($sth->{NAME}, [ 'name', $jpnGender ]); is_deeply($sth->{mariadb_table}, [ $jpnTable, $jpnTable ]); my $warn; my $dieerr; my $dbierr; my $failed; $failed = 0; $dieerr = undef; $dbierr = undef; $dbh->{HandleError} = sub { $dbierr = $_[0]; die $_[0]; }; eval { $sth = $dbh->prepare("foo"); $sth->execute(); 1; } or do { $dieerr = $@; $failed = 1; }; $dbh->{HandleError} = undef; ok($failed); like($dbierr, $jpnErr); like($DBI::errstr, $jpnErr); like($dbh->errstr, $jpnErr); SKIP : { skip_rt_102404 1; like($dieerr, $jpnErr); } $failed = 0; $warn = undef; $dieerr = undef; $dbh->{PrintError} = 1; $SIG{__WARN__} = sub { $warn = $_[0] }; eval { $sth = $dbh->prepare("foo"); $sth->execute(); 1; } or do { $dieerr = $@; $failed = 1; }; $dbh->{PrintError} = 0; $SIG{__WARN__} = 'default'; ok($failed); like($DBI::errstr, $jpnErr); like($dbh->errstr, $jpnErr); SKIP : { skip_rt_102404 2; like($warn, $jpnErr); like($dieerr, $jpnErr); }