Fixing implementation of PrintWarn to comply with the DBI specification.

I'm not sure why it doesn't warn anyway, but we'll survive with this for now.

Changes

@@ -15,6 +15,8 @@ Changes for Perl extension DBD-SQLite.
       CHORNY had inadvertantly applied the fix in the name of DBI cleaning)
     - Starting to use Test::NoWarnings in the test scripts (ADAMK)
     - Added link to MailingList resource (ADAMK)
+    - Squelch warnings inless PrintWarn is set in line with guidance from
+      the DBI documentation (ADAMK)
 
 1.19_08 Sat  4 Apr 2009
     - Bumped minimum DBI dependency to 1.43 so last_insert_id is supported

Makefile.PL

@@ -223,7 +223,10 @@ WriteMakefile(
 			},
 		},
 	),
-	OBJECT           => ( $force_local ? '$(O_FILES)' : 'SQLite.o dbdimp.o' ),
+	OBJECT           => ( $force_local
+		? '$(O_FILES)'
+		: 'SQLite.o dbdimp.o'
+	),
 	OPTIMIZE         => '-O2',
 	clean            => {
 		FILES => 'SQLite.xsi config.h tv.log',

lib/DBD/SQLite.pm

@@ -41,6 +41,11 @@ package DBD::SQLite::dr;
 sub connect {
     my ($drh, $dbname, $user, $auth, $attr) = @_;
 
+    # Default PrintWarn to the value of $^W
+    unless ( defined $attr->{PrintWarn} ) {
+        $attr->{PrintWarn} = $^W ? 1 : 0;
+    }
+
     my $dbh = DBI::_new_dbh( $drh, {
         Name => $dbname,
     } );
@@ -65,6 +70,12 @@ sub connect {
     $dbh->func( "perl",       $perl_collation,        "create_collation" );
     $dbh->func( "perllocale", $perl_locale_collation, "create_collation" );
 
+    # HACK: Since PrintWarn = 0 doesn't seem to actually prevent warnings
+    # in DBD::SQLite we set Warn to false if PrintWarn is false.
+    unless ( $attr->{PrintWarn} ) {
+        $attr->{Warn} = 0;
+    }
+
     return $dbh;
 }
 

t/30_auto_rollback.t

@@ -5,23 +5,20 @@
 use strict;
 BEGIN {
 	$|  = 1;
-	# $^W = 1;
+	$^W = 1;
 }
 
-use Test::More tests => 5;
-# use Test::NoWarnings;
+use Test::More tests => 6;
+use Test::NoWarnings;
 use t::lib::Test;
 
 SCOPE: {
-	my $dbh = connect_ok( RaiseError => 1 );
+	my $dbh = connect_ok( RaiseError => 1, PrintWarn => 0 );
+	ok( ! $dbh->{PrintWarn}, '->{PrintWarn} is false' );
 	ok( $dbh->do("CREATE TABLE f (f1, f2, f3)"), 'CREATE TABLE ok' );
 	ok( $dbh->begin_work, '->begin_work' );
 	ok(
 		$dbh->do("INSERT INTO f VALUES (?, ?, ?)", {}, 'foo', 'bar', 1),
 		'INSERT ok',
 	);
-
-	1;
 }
-
-1;