From: Peter Rabbitson Date: Tue, 7 Oct 2008 14:15:03 +0000 (+0000) Subject: Silence SQLite ->disconnect warnings X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b5bf138fc80fe8068328d397192fdd6529373ad8;p=dbsrgits%2FDBIx-Class-Historic.git Silence SQLite ->disconnect warnings --- diff --git a/lib/DBIx/Class/Storage/DBI/SQLite.pm b/lib/DBIx/Class/Storage/DBI/SQLite.pm index dbe5ea0..68d3ac3 100644 --- a/lib/DBIx/Class/Storage/DBI/SQLite.pm +++ b/lib/DBIx/Class/Storage/DBI/SQLite.pm @@ -45,6 +45,20 @@ sub backup return $backupfile; } +sub disconnect { + + # As described in this node http://www.perlmonks.org/?node_id=666210 + # there seems to be no sane way to ->disconnect a SQLite database with + # cached statement handles. As per mst we just zap the cache and + # proceed as normal. + + my $self = shift; + if ($self->connected) { + $self->_dbh->{CachedKids} = {}; + $self->next::method (@_); + } +} + 1; diff --git a/t/33storage_reconnect.t b/t/33storage_reconnect.t index 34dae6d..993cfad 100644 --- a/t/33storage_reconnect.t +++ b/t/33storage_reconnect.t @@ -7,7 +7,7 @@ use Test::More; use lib qw(t/lib); use DBICTest; -plan tests => 5; +plan tests => 6; my $db_orig = "$FindBin::Bin/var/DBIxClass.db"; my $db_tmp = "$db_orig.tmp"; @@ -20,7 +20,14 @@ my @art = $schema->resultset("Artist")->search({ }, { order_by => 'name DESC'}); cmp_ok(@art, '==', 3, "Three artists returned"); # Disconnect the dbh, and be sneaky about it -$schema->storage->_dbh->disconnect; +# Also test if DBD::SQLite finaly knows how to ->disconnect properly +TODO: { + local $TODO = 'SQLite is evil/braindead. Once this test starts passing, remove the related atrocity from DBIx::Class::Storage::DBI::SQLite'; + my $w; + local $SIG{__WARN__} = sub { $w = shift }; + $schema->storage->_dbh->disconnect; + ok ($w !~ /active statement handles/, 'SQLite can disconnect properly \o/'); +} # Try the operation again - What should happen here is: # 1. S::DBI blindly attempts the SELECT, which throws an exception @@ -40,10 +47,14 @@ close DBFILE; chmod 0000, $db_orig; ### Try the operation again... it should fail, since there's no db -eval { - my @art_three = $schema->resultset("Artist")->search( {}, { order_by => 'name DESC' } ); -}; -ok( $@, 'The operation failed' ); +{ + # Catch the DBI connection error + local $SIG{__WARN__} = sub {}; + eval { + my @art_three = $schema->resultset("Artist")->search( {}, { order_by => 'name DESC' } ); + }; + ok( $@, 'The operation failed' ); +} ### Now, move the db file back to the correct name unlink($db_orig);