Ah, you're passing it the address of (probably temporary) reference. It's the underlying object (which the ref points to) that you need.
Try something like:
PQsetNoticeProcessor(imp_dbh->conn, pg_warn, (void *)SvRV(dbh));
the D_imp_dbh( (SV *)arg ) will do-the-right-thing *if* the handle is the 'last handle used' ($DBI::lasth) whenever it's called.
That's probably not a safe assumption so you could try something more like this:
D_imp_dbh( sv_2mortal(newRV((SV*)arg)) );
Thank you! This worked a treat. It turned out that sv_2mortal() was necessary after all. I'm going to go away and read up on XS before I try this sort of thing again, I think.
Could somebody with a commit bit for dbdpg please apply the attached patch? It passes all tests here on perl 5.8.0 / postgres 7.3.2. I don't think that it will cause any problems for other perl versions...
-Dom
-- | Semantico: creators of major online resources | | URL: http://www.semantico.com/ | | Tel: +44 (1273) 722222 | | Address: 33 Bond St., Brighton, Sussex, BN1 1RD, UK. |
? Pg.xsi
Index: dbdimp.c
===================================================================
RCS file: /usr/local/cvsroot/dbdpg/dbdpg/dbdimp.c,v
retrieving revision 1.23
diff -u -r1.23 dbdimp.c
--- dbdimp.c 29 May 2003 08:37:46 -0000 1.23
+++ dbdimp.c 2 Jun 2003 16:33:51 -0000
@@ -76,7 +76,10 @@
void *arg;
const char *message;
{
- warn( message );
+ D_imp_dbh( sv_2mortal(newRV((SV*)arg)) );
+
+ if (DBIc_WARN(imp_dbh))
+ warn( message );
}
/* Database specific error handling. */
@@ -178,7 +181,7 @@
}
/* Enable warnings to go through perl */
- PQsetNoticeProcessor(imp_dbh->conn, pg_warn, NULL);
+ PQsetNoticeProcessor(imp_dbh->conn, pg_warn, (void *)SvRV(dbh));
/* Quick basic version check -- not robust a'tall TODO: rewrite */
pgres_ret = PQexec(imp_dbh->conn, "SELECT version()");
Index: t/01setup.t
===================================================================
RCS file: /usr/local/cvsroot/dbdpg/dbdpg/t/01setup.t,v
retrieving revision 1.5
diff -u -r1.5 01setup.t
--- t/01setup.t 6 May 2003 21:46:52 -0000 1.5
+++ t/01setup.t 2 Jun 2003 16:33:51 -0000
@@ -3,7 +3,7 @@
use Test::More;
if (defined $ENV{DBI_DSN}) {
- plan tests => 4;
+ plan tests => 5;
} else {
plan skip_all => 'cannot test without DB info';
}
@@ -32,6 +32,7 @@
'create table'
);
+# First, test that we can trap warnings.
eval { local $dbh->{PrintError} = 0; $dbh->do( "drop table test2" ) };
{
my $warning;
@@ -43,6 +44,19 @@
'PQsetNoticeProcessor working' );
}
eval { local $dbh->{PrintError} = 0; $dbh->do( "drop table test2" ) };
+
+# Next, test that we can disable warnings using $dbh.
+eval { local $dbh->{PrintError} = 0; $dbh->do( "drop table test3" ) };
+{
+ my $warning;
+ local $SIG{__WARN__} = sub { $warning = "@_" };
+ local $dbh->{Warn} = 0;
+ $dbh->do( "create table test3 (id integer primary key)" );
+ # XXX This will have to be updated if PostgreSQL ever changes its
+ # warnings...
+ is( $warning, undef, 'PQsetNoticeProcessor respects dbh->{Warn}' );
+}
+eval { local $dbh->{PrintError} = 0; $dbh->do( "drop table test3" ) };
ok($dbh->disconnect(),
'disconnect'
