From e1650f962b59c9af6819bab08d349cb6265f8e85 Mon Sep 17 00:00:00 2001
From: Adam Kennedy <adamk@cpan.org>
Date: Sun, 5 Apr 2009 02:03:53 +0000
Subject: [PATCH] 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              |  2 ++
 Makefile.PL          |  5 ++++-
 lib/DBD/SQLite.pm    | 11 +++++++++++
 t/30_auto_rollback.t | 13 +++++--------
 4 files changed, 22 insertions(+), 9 deletions(-)

diff --git a/Changes b/Changes
index e7f88c7..3e14312 100644
--- a/Changes
+++ b/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
diff --git a/Makefile.PL b/Makefile.PL
index dc77d88..512a41b 100644
--- a/Makefile.PL
+++ b/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',
diff --git a/lib/DBD/SQLite.pm b/lib/DBD/SQLite.pm
index 557b0e1..aff65da 100644
--- a/lib/DBD/SQLite.pm
+++ b/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;
 }
 
diff --git a/t/30_auto_rollback.t b/t/30_auto_rollback.t
index f612fa8..cd26e4e 100644
--- a/t/30_auto_rollback.t
+++ b/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;