[Alexander Foken - Sun Jan 30 11:03:02 2005]:
I have the same problems (on Win32). Attached is a test script that may
help you.
I also think that the C code of DBD::ODBC has to call the Unicode API
instead of the ANSI API (SQLFooBarFuncW instead of SQLFooBarFuncA). In
the worst case, runtime linking with LoadLibrary() and GetProcAddress()
may become necessary. As Microsoft uses UTF-16 (or UCS-2) for the API,
while Perl uses UTF-8, all strings have to be converted, preferably
using the Encode API.
Alexander
Show quoted text> [guest - Sun Jan 30 10:07:25 2005]:
>
> > I was using perl 5.8, and MSSQL 2000, trying to insert a unicode
> > string into a NVARCHAR field.
> > trying to debug and trace it, I found that DBD::ODBC, is always
> > calling the ANSI version of the ODBC APIs.
> > the same perl code, using DBD::ADO works fine.
>
>
> Can you please send me a self-contained test which shows the problem
> and
> demonstrates the failure?
>
> Preferrably one that conforms to the test suite and uses Test::More.
> Also, preferrably, one that creates the table it needs, insert,
> selects,
> and drops the table when the tests are done.
>
> THanks,
>
> Jeff
#!/usr/bin/perl -w -I./t
# based on *Id: 20SqlServer.t 568 2004-11-08 15:12:37Z jurl *
# proposed name: 21SqlServerUnicode.t
use strict;
use warnings;
use Test::More;
use DBI qw(:sql_types);
$|=1;
my @data;
my $tests;
# to help ActiveState's build process along by behaving (somewhat) if a dsn is not provided
BEGIN {
# for local debugging
$ENV{'DBI_DSN'}='dbi:ODBC:unicode_test';
$ENV{'DBI_USER'}=$ENV{'DBI_PASS'}='unicode_test';
# end
@data=(
"hello ASCII: the quick brown fox jumps over the yellow dog",
"Hello Unicode: german umlauts (\x{00C4}\x{00D6}\x{00DC}\x{00E4}\x{00F6}\x{00FC}\x{00DF}) smile (\x{263A}) hebrew shalom (\x{05E9}\x{05DC}\x{05D5}\x{05DD})",
);
utf8::is_utf8($data[0]) and die "Perl set UTF8 flag on non-unicode string constant";
utf8::is_utf8($data[1]) or die "Perl did not set UTF8 flag on unicode string constant";
$tests=6*@data;
if ($] < 5.008001) {
plan skip_all => "Old Perl lacking unicode support";
} elsif (!defined $ENV{DBI_DSN}) {
plan skip_all => "DBI_DSN is undefined";
} else {
plan tests => $tests,
}
}
sub dumpstr($)
{
my $str=shift;
my ($f,$u)=utf8::is_utf8($str) ? ('\\x{%04X}','utf8') : ('\\x%02X','bytes');
(my $d=$str)=~s/([^\x20-\x7E])/sprintf($f,ord $1)/gse;
return sprintf("[%s, %i chars] '%s'",$u,length($str),$d);
}
my $dbh = DBI->connect();
unless($dbh) {
BAIL_OUT("Unable to connect to the database $DBI::errstr\nTests skipped.\n");
exit 0;
}
my $dbname = $dbh->get_info(17); # DBI::SQL_DBMS_NAME
SKIP: {
skip "Microsoft SQL Server tests not supported using $dbname",$tests unless ($dbname =~ /Microsoft SQL Server/i);
eval {
local $dbh->{PrintError}=0;
$dbh->do("DROP TABLE PERL_DBD_TABLE1");
};
$dbh->{RaiseError} = 1;
$dbh->do("CREATE TABLE PERL_DBD_TABLE1 (i INTEGER primary key, nva NVARCHAR(1000), nvb NVARCHAR(1000), nvc NVARCHAR(1000))");
# Insert records into the database:
my $sth=$dbh->prepare("INSERT INTO PERL_DBD_TABLE1 (i,nva,nvb,nvc) values (?,?,?,?)");
for (my $i=0; $i<@data; $i++) {
my ($nva,$nvb,$nvc)=($data[$i]) x 3;
$sth->bind_param (1, $i, SQL_INTEGER);
$sth->bind_param (2, $nva);
$sth->bind_param (3, $nvb, SQL_VARCHAR);
$sth->bind_param (4, $nvc, SQL_WVARCHAR);
$sth->execute or die ($DBI::errstr);
}
$sth->finish();
# Retrieve records from the database, and see if they match original data:
$sth=$dbh->prepare("SELECT i,nva,nvb,nvc FROM PERL_DBD_TABLE1");
$sth->execute or die ($DBI::errstr);
while (my ($i,$nva,$nvb,$nvc)=$sth->fetchrow_array()) {
unless (
ok(utf8::is_utf8($data[$i])==utf8::is_utf8($nva),'utf8 flag matches')
* # 'and' uses shortcuts, so multiply!
ok($data[$i] eq $nva,'value matches')
) {
diag("index: $i");
diag("wrote: ".dumpstr($data[$i])."\n");
diag("read from untyped nvarchar: ".dumpstr($nva)."\n");
}
unless (
ok(utf8::is_utf8($data[$i])==utf8::is_utf8($nvb),'utf8 flag matches')
*
ok($data[$i] eq $nvb,'value matches')
) {
diag("index: $i");
diag("wrote: ".dumpstr($data[$i])."\n");
diag("read from SQL_VARCHAR nvarchar: ".dumpstr($nvb)."\n");
}
unless (
ok(utf8::is_utf8($data[$i])==utf8::is_utf8($nvc),'utf8 flag matches')
*
ok($data[$i] eq $nvc,'value matches')
) {
diag("index: $i");
diag("wrote: ".dumpstr($data[$i])."\n");
diag("read from SQL_WVARCHAR nvarchar: ".dumpstr($nvc)."\n");
}
}
eval {
print "you may want to look at the table now, the unicode data is damaged!\nHit Enter to continue\n";
$_=<STDIN>;
};
eval {
local $dbh->{RaiseError} = 0;
$dbh->do("DROP TABLE PERL_DBD_TABLE1");
};
$dbh->disconnect;
}
exit 0;
