Tim Bunce wrote:
>
> I'd also like driver authors to consider/try-out the new
> [...]
> - Recording 'success with info' (incl db messages etc) and 'warnings'
The attached patch is for testing purposes only!
Calling perl -Mblib set_err.pl, the sequence
$dbh->set_err( '','E1');
$dbh->set_err( 0 ,'E2'); # nok
(in DBD::NullP::db::nullp_test) doesn't escalate from info to warning:
- set DBI_TRACE=4
-> nullp_test for DBD::NullP::db (DBI::db=HASH(0x1849ad0)~0x1847b04) thr#015EEFD4
1 -> set_err in DBD::_::common for DBD::NullP::db (DBI::db=HASH(0x1847b04)~INNER ''
'E1') thr#015EEFD4
*0 0
*2 0
*3 0
!! info: '' 'E1'
1 <- set_err= undef at NullP.pm line 54 via set_err.pl line 6
1 -> set_err for DBD::NullP::db (DBI::db=HASH(0x1847b04)~INNER 0 'E2') thr#015EEFD4
*0 25877580
*1 0
*2 25877580
*3 0
!! info: 0 'E1
E2'
1 <- set_err= undef at NullP.pm line 55 via set_err.pl line 6
!! info: 0 'E1
E2'
<- nullp_test= undef at set_err.pl line 6
- set DBI_TRACE=0
*0 0
*2 0
*3 0
*0 0
*1 0
However
$dbh->set_err( '','E1');
$dbh->set_err('0','E2'); # ok
works:
-> nullp_test for DBD::NullP::db (DBI::db=HASH(0x1849ad0)~0x1847b04) thr#015EEFD4
1 -> set_err in DBD::_::common for DBD::NullP::db (DBI::db=HASH(0x1847b04)~INNER ''
'E1') thr#015EEFD4
*0 0
*2 0
*3 0
!! info: '' 'E1'
1 <- set_err= undef at NullP.pm line 54 via set_err.pl line 6
1 -> set_err for DBD::NullP::db (DBI::db=HASH(0x1847b04)~INNER '0' 'E2') thr#015EEFD4
*0 1
*1 0
*2 1
*3 1
!! warn: '0' 'E1
E2'
1 <- set_err= undef at NullP.pm line 56 via set_err.pl line 6
!! warn: '0' 'E1
E2'
<- nullp_test= undef at set_err.pl line 6
DBD::NullP::db nullp_test warning: E1
E2 at set_err.pl line 6.
Is there a problem with SvCUR and numeric 0 (at least in perl v5.6.1)?
Steffendiff -bruN DBI-1.41-RC1-orig/DBI.pm DBI-1.41-RC1/DBI.pm
--- DBI-1.41-RC1-orig/DBI.pm Tue Feb 17 13:18:08 2004
+++ DBI-1.41-RC1/DBI.pm Thu Feb 19 12:22:39 2004
@@ -316,6 +316,7 @@
ix_ => { class => 'DBD::Informix', },
msql_ => { class => 'DBD::mSQL', },
mysql_ => { class => 'DBD::mysql', },
+ nullp_ => { class => 'DBD::NullP', },
odbc_ => { class => 'DBD::ODBC', },
ora_ => { class => 'DBD::Oracle', },
pg_ => { class => 'DBD::Pg', },
diff -bruN DBI-1.41-RC1-orig/DBI.xs DBI-1.41-RC1/DBI.xs
--- DBI-1.41-RC1-orig/DBI.xs Mon Feb 16 14:57:32 2004
+++ DBI-1.41-RC1/DBI.xs Thu Feb 19 12:39:31 2004
@@ -484,13 +484,18 @@
else
sv_setsv(h_errstr, errstr);
+ PerlIO_printf(DBIc_LOGPIO(imp_xxh)," *0 %d\n", SvCUR(err));
+ if ( SvOK(h_err) )
+ PerlIO_printf(DBIc_LOGPIO(imp_xxh)," *1 %d\n", SvCUR(h_err));
/* SvTRUE(err) > "0" > "" > undef */
if (SvTRUE(err) /* new error: so assign */
|| !SvOK(h_err) /* no existing warn/info: so assign */
/* new warn ("0" len 1) > info ("" len 0): so assign */
|| (SvOK(err) && SvCUR(err) > SvCUR(h_err)) ) {
+ PerlIO_printf(DBIc_LOGPIO(imp_xxh)," *2 %d\n", SvCUR(err));
sv_setsv(h_err, err);
err_changed = 1;
+ PerlIO_printf(DBIc_LOGPIO(imp_xxh)," *3 %d\n", SvCUR(h_err));
}
if (SvTRUE(state) && err_changed) {
diff -bruN DBI-1.41-RC1-orig/lib/DBD/NullP.pm DBI-1.41-RC1/lib/DBD/NullP.pm
--- DBI-1.41-RC1-orig/lib/DBD/NullP.pm Wed Jan 07 18:40:14 2004
+++ DBI-1.41-RC1/lib/DBD/NullP.pm Thu Feb 19 13:41:45 2004
@@ -25,6 +25,7 @@
'Version' => $VERSION,
'Attribution' => 'DBD Example Null Perl stub by Tim Bunce',
}, [ qw'example implementors private data']);
+ DBD::NullP::db->install_method('nullp_test');
$drh;
}
@@ -46,6 +47,15 @@
{ package DBD::NullP::db; # ====== DATABASE ======
$imp_data_size = 0;
use strict;
+
+ sub nullp_test {
+ my($dbh)= @_;
+# $dbh->set_err( 0 ,'E0'); # ok
+ $dbh->set_err( '','E1');
+ $dbh->set_err( 0 ,'E2'); # nok
+# $dbh->set_err('0','E2'); # ok
+# $dbh->set_err( 1 ,'E3'); # ok
+ }
sub prepare {
my($dbh, $statement)= @_;
diff -bruN DBI-1.41-RC1-orig/set_err.pl DBI-1.41-RC1/set_err.pl
--- DBI-1.41-RC1-orig/set_err.pl Thu Jan 01 01:00:00 1970
+++ DBI-1.41-RC1/set_err.pl Thu Feb 19 12:44:59 2004
@@ -0,0 +1,6 @@
+use DBI();
+
+my $dbh = DBI->connect('dbi:NullP:','','', { PrintError => 1 } )
+ or die $DBI::errstr;
+
+my $sth = $dbh->nullp_test;
