Author: timbo
Date: Sun Oct 3 15:01:08 2004
New Revision: 476
Added:
dbi/trunk/t/14utf8.t
Modified:
dbi/trunk/Changes
dbi/trunk/DBI.pm
dbi/trunk/DBI.xs
dbi/trunk/MANIFEST
dbi/trunk/t/08keeperr.t
dbi/trunk/t/10examp.t
Log:
Fixed risk of utf8 flag persisting from one row to the next.
Some other minor cleanups.
Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes (original)
+++ dbi/trunk/Changes Sun Oct 3 15:01:08 2004
@@ -6,11 +6,10 @@
=head2 Changes in DBI 1.44 (svn rev 442), XXX
-fix utf8 leakage
-
Fixed build issues on VMS thanks to Jakob Snoer.
Fixed DBD::File finish() method to return 1 thanks to Jan Dubois.
Fixed rare core dump during global destruction thanks to Mark Jason Dominus.
+ Fixed risk of utf8 flag persisting from one row to the next.
Changed bind_param_array() so it doesn't require all bind arrays
to have the same number of elements.
Modified: dbi/trunk/DBI.pm
==============================================================================
--- dbi/trunk/DBI.pm (original)
+++ dbi/trunk/DBI.pm Sun Oct 3 15:01:08 2004
@@ -1300,7 +1300,9 @@
my ($this) = DBI::_new_dbh($drh, {
'Name' => $dsn,
});
- # $this->STORE(Active => 1); debatable as there's no "server side" here
+ # XXX debatable as there's no "server side" here
+ # (and now many uses would trigger warnings on DESTROY)
+ # $this->STORE(Active => 1);
$this;
}
Modified: dbi/trunk/DBI.xs
==============================================================================
--- dbi/trunk/DBI.xs (original)
+++ dbi/trunk/DBI.xs Sun Oct 3 15:01:08 2004
@@ -1261,6 +1261,14 @@
if ( (av = DBIc_FIELDS_AV(imp_sth)) == Nullav)
av = dbih_setup_fbav(imp_sth);
+ if (1) { /* XXX turn into option later */
+ int i = DBIc_NUM_FIELDS(imp_sth);
+ /* don't let SvUTF8 flag persist from one row to the next */
+ /* (only affects drivers that use sv_setpv, but most XS do) */
+ while(i--) /* field 1 stored at index 0 */
+ SvUTF8_off(AvARRAY(av)[i]);
+ }
+
if (DBIc_is(imp_sth, DBIcf_TaintOut)) {
dTHR;
TAINT; /* affects sv_setsv()'s called within same perl statement */
Modified: dbi/trunk/MANIFEST
==============================================================================
--- dbi/trunk/MANIFEST (original)
+++ dbi/trunk/MANIFEST Sun Oct 3 15:01:08 2004
@@ -49,6 +49,7 @@
t/08keeperr.t
t/09trace.t
t/10examp.t
+t/14utf8.t
t/15array.t
t/20meta.t
t/30subclass.t
Modified: dbi/trunk/t/08keeperr.t
==============================================================================
--- dbi/trunk/t/08keeperr.t (original)
+++ dbi/trunk/t/08keeperr.t Sun Oct 3 15:01:08 2004
@@ -34,7 +34,7 @@
sub execute {
my $sth = shift;
- # we localize and attribute here to check that the correpoding STORE
+ # we localize an attribute here to check that the correpoding STORE
# at scope exit doesn't clear any recorded error
local $sth->{CompatMode} = 0;
my $rv = $sth->SUPER::execute(@_);
Modified: dbi/trunk/t/10examp.t
==============================================================================
--- dbi/trunk/t/10examp.t (original)
+++ dbi/trunk/t/10examp.t Sun Oct 3 15:01:08 2004
@@ -256,16 +256,16 @@
ok($row_a[2] eq $col2) or print "$row_a[2] ne $col2\n";
#$csr_a->trace(0);
-# Check Taint attribute works. This requires this test to be run
-# manually with the -T flag: "perl -T -Mblib t/examp.t"
-sub is_tainted {
- my $foo;
- return ! eval { ($foo=join('',@_)), kill 0; 1; };
-}
-
SKIP: {
+ # Check Taint attribute works. This requires this test to be run
+ # manually with the -T flag: "perl -T -Mblib t/examp.t"
+ sub is_tainted {
+ my $foo;
+ return ! eval { ($foo=join('',@_)), kill 0; 1; };
+ }
+
skip " Taint attribute tests skipped\n", 19 unless(is_tainted($^X) &&
!$DBI::PurePerl);
$dbh->{'Taint'} = 0;
Added: dbi/trunk/t/14utf8.t
==============================================================================
--- (empty file)
+++ dbi/trunk/t/14utf8.t Sun Oct 3 15:01:08 2004
@@ -0,0 +1,62 @@
+#!perl -w
+# vim:ts=8:sw=4
+
+use Test::More;
+use DBI;
+
+plan skip_all => "Requires perl 5.8"
+ unless $] >= 5.008;
+
+eval {
+ require Storable;
+ import Storable qw(dclone);
+ require Encode;
+ import Encode qw(_utf8_on _utf8_off is_utf8);
+};
+
+plan skip_all => "Unable to load required module ($@)"
+ unless defined &_utf8_on;
+
+plan tests => 12;
+
+$dbh = DBI->connect("dbi:Sponge:foo","","", {
+ PrintError => 0,
+ RaiseError => 1,
+});
+
+my $source_rows = [ # data for DBD::Sponge to return via fetch
+ [ 41, "AAA", 9 ],
+ [ 42, "BB", undef ],
+ [ 43, undef, 7 ],
+ [ 44, "DDD", 6 ],
+];
+
+my($sth, $col0, $col1, $col2, $rows);
+
+$sth = $dbh->prepare("foo", { rows => dclone($source_rows) });
+
+ok($sth->bind_columns(\($col0, $col1, $col2)) );
+ok($sth->execute(), $DBI::errstr);
+
+ok $sth->fetch;
+cmp_ok $col1, 'eq', "AAA";
+ok !is_utf8($col1);
+
+# force utf8 flag on
+_utf8_on($col1);
+ok is_utf8($col1);
+
+ok $sth->fetch;
+cmp_ok $col1, 'eq', "BB";
+# XXX sadly this test doesn't detect the problem when using DBD::Sponge
+# because DBD::Sponge uses $sth->_set_fbav (correctly) and that uses
+# sv_setsv which doesn't have the utf8 persistence that sv_setpv does.
+ok !is_utf8($col1); # utf8 flag should have been reset
+
+ok $sth->fetch;
+ok !defined $col1; # null
+ok !is_utf8($col1); # utf8 flag should have been reset
+
+$sth->finish;
+
+# end
