From: Bruce Momjian <pgman@candle.pha.pa.us>
Message-Id: <200307082238.h68Mcp605948@candle.pha.pa.us>
Subject: Re: DBD::Pg 1.30_1 WAS (Re: Prepare and prepare ?)
In-Reply-To: <3EDB7F17.7010607@semantico.com>
To: Dominic Mitchell <dom@semantico.com>
Date: Tue, 8 Jul 2003 18:38:51 -0400 (EDT)
Cc: Tim Bunce <Tim.Bunce@pobox.com>, Rudy Lippan <rlippan@remotelinux.com>,
	David Wheeler <david@wheeler.net>, pgsql-interfaces@postgresql.org,
	"'DBI developers'" <dbi-dev@perl.org>
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Content-Type: text/plain; charset=US-ASCII


Thanks.  Patch applied.

---------------------------------------------------------------------------

Dominic Mitchell wrote:
> Tim Bunce wrote:
> > 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'

-- 
  Bruce Momjian                        |  http://candle.pha.pa.us
  pgman@candle.pha.pa.us               |  (610) 359-1001
  +  If your life is a hard drive,     |  13 Roberts Road
  +  Christ can be your backup.        |  Newtown Square, Pennsylvania 19073