[Bast-commits] r3695 - in DBIx-Class/0.08/trunk: . lib/DBIx/Class/Storage t t/lib

matthewt at dev.catalyst.perl.org matthewt at dev.catalyst.perl.org
Tue Aug 21 19:24:53 GMT 2007


Author: matthewt
Date: 2007-08-21 19:24:53 +0100 (Tue, 21 Aug 2007)
New Revision: 3695

Added:
   DBIx-Class/0.08/trunk/t/92storage_on_connect_do.t
Modified:
   DBIx-Class/0.08/trunk/
   DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm
   DBIx-Class/0.08/trunk/t/lib/DBICTest.pm
Log:
 r10460 at jules (orig r3640):  tomboh | 2007-08-01 12:27:38 +0100
 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.
 



Property changes on: DBIx-Class/0.08/trunk
___________________________________________________________________
Name: svk:merge
   - 168d5346-440b-0410-b799-f706be625ff1:/DBIx-Class-current:2207
462d4d0c-b505-0410-bf8e-ce8f877b3390:/local/bast/DBIx-Class:3159
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-C3:318
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-current:2222
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-joins:173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-resultset:570
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/datetime:1716
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_compat:1855
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_unique_query_fixes:2142
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/inflate:1988
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/many_to_many:2025
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/re_refactor_bugfix:1944
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/reorganize_tests:1827
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset-new-refactor:1766
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_2_electric_boogaloo:2175
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_cleanup:2102
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/sqlt_tests_refactor:2043
   + 168d5346-440b-0410-b799-f706be625ff1:/DBIx-Class-current:2207
462d4d0c-b505-0410-bf8e-ce8f877b3390:/local/bast/DBIx-Class:3159
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/on_disconnect_do:3640
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-C3:318
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-current:2222
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-joins:173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-resultset:570
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/datetime:1716
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_compat:1855
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_unique_query_fixes:2142
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/inflate:1988
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/many_to_many:2025
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/re_refactor_bugfix:1944
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/reorganize_tests:1827
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset-new-refactor:1766
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_2_electric_boogaloo:2175
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_cleanup:2102
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/sqlt_tests_refactor:2043

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm	2007-08-21 18:11:04 UTC (rev 3694)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm	2007-08-21 18:24:53 UTC (rev 3695)
@@ -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 on_connect_do
-       transaction_depth unsafe _dbh_autocommit/
+       on_disconnect_do transaction_depth unsafe _dbh_autocommit/
 );
 
 __PACKAGE__->cursor_class('DBIx::Class::Storage::DBI::Cursor');
@@ -347,10 +347,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
@@ -481,9 +490,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 cursor_class/
-      ) {
+    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);
       }
@@ -650,6 +659,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);
@@ -742,17 +754,30 @@
     }
   }
 
-  # if on-connect sql statements are given execute them
-  foreach my $sql_statement (@{$self->on_connect_do || []}) {
-    $self->_query_start($sql_statement);
-    $self->_dbh->do($sql_statement);
-    $self->_query_end($sql_statement);
+  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/trunk/t/92storage_on_connect_do.t
===================================================================
--- DBIx-Class/0.08/trunk/t/92storage_on_connect_do.t	                        (rev 0)
+++ DBIx-Class/0.08/trunk/t/92storage_on_connect_do.t	2007-08-21 18:24:53 UTC (rev 3695)
@@ -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/trunk/t/lib/DBICTest.pm
===================================================================
--- DBIx-Class/0.08/trunk/t/lib/DBICTest.pm	2007-08-21 18:11:04 UTC (rev 3694)
+++ DBIx-Class/0.08/trunk/t/lib/DBICTest.pm	2007-08-21 18:24:53 UTC (rev 3695)
@@ -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