[Bast-commits] r3640 - in DBIx-Class/0.08/branches/on_disconnect_do:
lib/DBIx/Class/Storage t t/lib
tomboh at dev.catalyst.perl.org
tomboh at dev.catalyst.perl.org
Wed Aug 1 12:27:41 GMT 2007
Author: tomboh
Date: 2007-08-01 12:27:38 +0100 (Wed, 01 Aug 2007)
New Revision: 3640
Added:
DBIx-Class/0.08/branches/on_disconnect_do/t/92storage_on_connect_do.t
Modified:
DBIx-Class/0.08/branches/on_disconnect_do/lib/DBIx/Class/Storage/DBI.pm
DBIx-Class/0.08/branches/on_disconnect_do/t/lib/DBICTest.pm
Log:
Add an 'on_disconnect_do' argument to
DBIx::Class::Storage::DBI::connect_info that, on disconnection, do what
'on_connect_do' does on connection. Currently, this only works if the
code explicitly calls disconnect() on the Storage object.
While I'm here, make both 'on_connect_do' and 'on_disconnect_do' accept
code references as well as strings containing SQL statements.
Finally, remove code to call compose_connection() from DBICTest.pm that
never gets called any more.
Modified: DBIx-Class/0.08/branches/on_disconnect_do/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/branches/on_disconnect_do/lib/DBIx/Class/Storage/DBI.pm 2007-08-01 10:53:19 UTC (rev 3639)
+++ DBIx-Class/0.08/branches/on_disconnect_do/lib/DBIx/Class/Storage/DBI.pm 2007-08-01 11:27:38 UTC (rev 3640)
@@ -14,7 +14,7 @@
__PACKAGE__->mk_group_accessors('simple' =>
qw/_connect_info _dbi_connect_info _dbh _sql_maker _sql_maker_opts
_conn_pid _conn_tid disable_sth_caching cursor on_connect_do
- transaction_depth unsafe _dbh_autocommit/
+ on_disconnect_do transaction_depth unsafe _dbh_autocommit/
);
BEGIN {
@@ -346,10 +346,19 @@
=item on_connect_do
-This can be set to an arrayref of literal sql statements, which will
-be executed immediately after making the connection to the database
-every time we [re-]connect.
+This can be set to an arrayref containing literal sql statements and
+code references, which will be executed immediately after making the
+connection to the database every time we [re-]connect.
+=item on_disconnect_do
+
+As with L<on_connect_do>, this takes an arrayref of literal sql
+statements and code references, but these statements execute immediately
+before disconnecting from the database.
+
+Note, this only runs if you explicitly call L<disconnect> on the
+storage object.
+
=item disable_sth_caching
If set to a true value, this option will disable the caching of
@@ -480,7 +489,9 @@
my $last_info = $dbi_info->[-1];
if(ref $last_info eq 'HASH') {
$last_info = { %$last_info }; # so delete is non-destructive
- for my $storage_opt (qw/on_connect_do disable_sth_caching unsafe/) {
+ my @storage_option =
+ qw/on_connect_do on_disconnect_do disable_sth_caching unsafe/;
+ for my $storage_opt (@storage_option) {
if(my $value = delete $last_info->{$storage_opt}) {
$self->$storage_opt($value);
}
@@ -647,6 +658,9 @@
my ($self) = @_;
if( $self->connected ) {
+ foreach (@{$self->on_disconnect_do || []}) {
+ $self->_do_query($_);
+ }
$self->_dbh->rollback unless $self->_dbh_autocommit;
$self->_dbh->disconnect;
$self->_dbh(undef);
@@ -738,17 +752,30 @@
}
}
- # if on-connect sql statements are given execute them
- foreach my $sql_statement (@{$self->on_connect_do || []}) {
- $self->debugobj->query_start($sql_statement) if $self->debug();
- $self->_dbh->do($sql_statement);
- $self->debugobj->query_end($sql_statement) if $self->debug();
+ foreach (@{$self->on_connect_do || []}) {
+ $self->_do_query($_);
}
$self->_conn_pid($$);
$self->_conn_tid(threads->tid) if $INC{'threads.pm'};
}
+sub _do_query {
+ my ($self, $action) = @_;
+
+ # $action contains either an SQL string or a code ref
+ if (ref $action) {
+ $action->($self);
+ }
+ else {
+ $self->debugobj->query_start($action) if $self->debug();
+ $self->_dbh->do($action);
+ $self->debugobj->query_end($action) if $self->debug();
+ }
+
+ return $self;
+}
+
sub _connect {
my ($self, @info) = @_;
Added: DBIx-Class/0.08/branches/on_disconnect_do/t/92storage_on_connect_do.t
===================================================================
--- DBIx-Class/0.08/branches/on_disconnect_do/t/92storage_on_connect_do.t (rev 0)
+++ DBIx-Class/0.08/branches/on_disconnect_do/t/92storage_on_connect_do.t 2007-08-01 11:27:38 UTC (rev 3640)
@@ -0,0 +1,38 @@
+use strict;
+use warnings;
+
+use Test::More tests => 5;
+
+use lib qw(t/lib);
+use base 'DBICTest';
+
+
+my $schema = DBICTest->init_schema(
+ no_connect => 1,
+ no_deploy => 1,
+);
+ok $schema->connection(
+ DBICTest->_database,
+ {
+ on_connect_do => ['CREATE TABLE TEST_empty (id INTEGER)'],
+ on_disconnect_do =>
+ [\&check_exists, 'DROP TABLE TEST_empty', \&check_dropped],
+ },
+), 'connection()';
+
+ok $schema->storage->dbh->do('SELECT 1 FROM TEST_empty'), 'on_connect_do() worked';
+eval { $schema->storage->dbh->do('SELECT 1 FROM TEST_nonexistent'); };
+ok $@, 'Searching for nonexistent table dies';
+
+$schema->storage->disconnect();
+
+sub check_exists {
+ my $storage = shift;
+ ok $storage->dbh->do('SELECT 1 FROM TEST_empty'), 'Table still exists';
+}
+
+sub check_dropped {
+ my $storage = shift;
+ eval { $storage->dbh->do('SELECT 1 FROM TEST_empty'); };
+ ok $@, 'Reading from dropped table fails';
+}
Modified: DBIx-Class/0.08/branches/on_disconnect_do/t/lib/DBICTest.pm
===================================================================
--- DBIx-Class/0.08/branches/on_disconnect_do/t/lib/DBICTest.pm 2007-08-01 10:53:19 UTC (rev 3639)
+++ DBIx-Class/0.08/branches/on_disconnect_do/t/lib/DBICTest.pm 2007-08-01 11:27:38 UTC (rev 3640)
@@ -42,9 +42,8 @@
=cut
-sub init_schema {
+sub _database {
my $self = shift;
- my %args = @_;
my $db_file = "t/var/DBIxClass.db";
unlink($db_file) if -e $db_file;
@@ -55,19 +54,22 @@
my $dbuser = $ENV{"DBICTEST_DBUSER"} || '';
my $dbpass = $ENV{"DBICTEST_DBPASS"} || '';
+ my @connect_info = ($dsn, $dbuser, $dbpass, { AutoCommit => 1 });
+
+ return @connect_info;
+}
+
+sub init_schema {
+ my $self = shift;
+ my %args = @_;
+
my $schema;
- my @connect_info = ($dsn, $dbuser, $dbpass, { AutoCommit => 1 });
-
- if ($args{compose_connection}) {
- $schema = DBICTest::Schema->compose_connection(
- 'DBICTest', @connect_info
- );
- } else {
- $schema = DBICTest::Schema->compose_namespace('DBICTest')
- ->connect(@connect_info);
+ $schema = DBICTest::Schema->compose_namespace('DBICTest');
+ if ( !$args{no_connect} ) {
+ $schema = $schema->connect($self->_database);
+ $schema->storage->on_connect_do(['PRAGMA synchronous = OFF']);
}
- $schema->storage->on_connect_do(['PRAGMA synchronous = OFF']);
if ( !$args{no_deploy} ) {
__PACKAGE__->deploy_schema( $schema );
__PACKAGE__->populate_schema( $schema ) if( !$args{no_populate} );
More information about the Bast-commits
mailing list