On Tue, Feb 28, 2006 at 01:12:38PM +0800, Alexey Gaidukov wrote:
> I tested perl-DBI-1.48 and perl-DBI-1.50.
>
> In the simple testcase
>
> while($hash_ref = $dep_sth->fetchrow_hashref) {
> foreach my $key (keys(%$hash_ref)) {
> print "(".utf8::is_utf8($key).") ".$key."\n";
> }
> print "\n";
> foreach my $value (values(%$hash_ref)) {
> print "(".utf8::is_utf8($value).") ".$value."\n";
> }
> }
>
> I found that keys from fetchrow_hashref are always with turned off SvUTF8.
> The reason was using
>
> SV** hv_store(HV* tb, const char* key, I32 klen, SV* val, U32 hash)
>
> to put values into a hash in fetchrow_hashref function in DBI.xs. Key is
> char* type. It is correct to use hv_store_ent.
>
> I propose the following patch
Thanks Alexey.
> 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);
> - char *field_name = SvPV(*field_name_svp, len);
> - hv_store(hv, field_name, len, newSVsv((SV*)(AvARRAY(rowav)[i])),
> 0);
> + hv_store_ent(hv, newSVsv(*field_name_svp),
> newSVsv((SV*)(AvARRAY(rowav)[i])), 0);
> }
I believe hv_store_ent doesn't need the newSVsv on the key parameter.
It doesn't take ownership of a reference. So I ended up with the
appended patch.
Thanks Alexey. It's great to get patches along with bug reports!
Tim.
Index: DBI.xs
===================================================================
--- DBI.xs (revision 2565)
+++ DBI.xs (working copy)
@@ -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 */
Index: t/14utf8.t
===================================================================
--- t/14utf8.t (revision 2306)
+++ t/14utf8.t (working copy)
@@ -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,8 +33,18 @@
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
Index: Changes
===================================================================
--- Changes (revision 2565)
+++ Changes (working copy)
@@ -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.
