Author: timbo
Date: Tue Feb 28 05:54:01 2006
New Revision: 2621
Modified:
dbi/trunk/Changes
dbi/trunk/DBI.xs
dbi/trunk/t/14utf8.t
Log:
Fixed fetching of rows as hash refs to preserve utf8 on field names
from $sth->{NAME} thanks to Alexey Gaidukov.
Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes (original)
+++ dbi/trunk/Changes Tue Feb 28 05:54:01 2006
@@ -15,6 +15,8 @@
to report incorrect number of parameters, thanks to Ben Thul.
Fixed for perl 5.9.x for non-threaded builds thanks to Nicholas Clark.
Users of Perl >= 5.9.x will require DBI >= 1.51.
+ Fixed fetching of rows as hash refs to preserve utf8 on field names
+ from $sth->{NAME} thanks to Alexey Gaidukov.
Improved performance for thread-enabled perls thanks to Gisle Aas.
Drivers can now use PERL_NO_GET_CONTEXT thanks to Gisle Aas.
Modified: dbi/trunk/DBI.xs
==============================================================================
--- dbi/trunk/DBI.xs (original)
+++ dbi/trunk/DBI.xs Tue Feb 28 05:54:01 2006
@@ -4210,10 +4210,8 @@
ka_av = (AV*)SvRV(ka_rv);
hv = newHV();
for (i=0; i < num_fields; ++i) { /* honor the original order as
sent by the database */
- STRLEN len;
SV **field_name_svp = av_fetch(ka_av, i, 1);
- const char *field_name = SvPV(*field_name_svp, len);
- hv_store(hv, field_name, len, newSVsv((SV*)(AvARRAY(rowav)[i])), 0);
+ hv_store_ent(hv, *field_name_svp,
newSVsv((SV*)(AvARRAY(rowav)[i])), 0);
}
RETVAL = newRV((SV*)hv);
SvREFCNT_dec(hv); /* since newRV incremented it */
Modified: dbi/trunk/t/14utf8.t
==============================================================================
--- dbi/trunk/t/14utf8.t (original)
+++ dbi/trunk/t/14utf8.t Tue Feb 28 05:54:01 2006
@@ -17,7 +17,7 @@
plan skip_all => "Unable to load required module ($@)"
unless defined &_utf8_on;
-plan tests => 12;
+plan tests => 16;
$dbh = DBI->connect("dbi:Sponge:foo","","", {
PrintError => 0,
@@ -33,7 +33,17 @@
my($sth, $col0, $col1, $col2, $rows);
-$sth = $dbh->prepare("foo", { rows => dclone($source_rows) });
+# set utf8 on one of the columns so we can check it carries through into the
+# keys of fetchrow_hashref
+my @col_names = qw(Col1 Col2 Col3);
+_utf8_on($col_names[1]);
+ok is_utf8($col_names[1]);
+ok !is_utf8($col_names[0]);
+
+$sth = $dbh->prepare("foo", {
+ rows => dclone($source_rows),
+ NAME => [EMAIL PROTECTED],
+});
ok($sth->bind_columns(\($col0, $col1, $col2)) );
ok($sth->execute(), $DBI::errstr);
@@ -57,6 +67,9 @@
ok !defined $col1; # null
ok !is_utf8($col1); # utf8 flag should have been reset
+ok my $hash = $sth->fetchrow_hashref;
+ok 1 == grep { is_utf8($_) } keys %$hash;
+
$sth->finish;
# end
