From: Brandon L. Black <blblack@gmail.com>
Date: Thu, 24 Aug 2006 18:33:45 +0000 (+0000)
Subject: clean up the way dbh_do is used in Storage::* so that inheritance can work and its... 
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d4f16b21abb7a541e0c44bfe3ec68309a8d722fa;p=dbsrgits%2FDBIx-Class-Historic.git

clean up the way dbh_do is used in Storage::* so that inheritance can work and its not (as) ugly
---

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 9be6d42..37b586e 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -452,19 +452,26 @@ This method is deprecated in favor of setting via L</connect_info>.
 
 Arguments: $subref, @extra_coderef_args?
 
-Execute the given subref with the underlying database handle as its
-first argument, using the new exception-based connection management.
+Execute the given subref using the new exception-based connection management.
 
-Any additional arguments will be passed verbatim to the called subref
-as arguments 2 and onwards.
+The first two arguments will be the storage object that C<dbh_do> was called
+on and a database handle to use.  Any additional arguments will be passed
+verbatim to the called subref as arguments 2 and onwards.
+
+Using this (instead of $self->_dbh or $self->dbh) ensures correct
+exception handling and reconnection (or failover in future subclasses).
+
+Your subref should have no side-effects outside of the database, as
+there is the potential for your subref to be partially double-executed
+if the database connection was stale/dysfunctional.
 
 Example:
 
   my @stuff = $schema->storage->dbh_do(
     sub {
-      my $dbh = shift;
-      my $cols = join(q{, }, @_);
-      shift->selectrow_array("SELECT $cols FROM foo")
+      my ($storage, $dbh, @cols) = @_;
+      my $cols = join(q{, }, @cols);
+      $dbh->selectrow_array("SELECT $cols FROM foo");
     },
     @column_list
   );
@@ -475,7 +482,7 @@ sub dbh_do {
   my $self = shift;
   my $coderef = shift;
 
-  return $coderef->($self->_dbh, @_) if $self->{_in_txn_do};
+  return $coderef->($self, $self->_dbh, @_) if $self->{_in_txn_do};
 
   ref $coderef eq 'CODE' or $self->throw_exception
     ('$coderef must be a CODE reference');
@@ -487,13 +494,13 @@ sub dbh_do {
     $self->_verify_pid if $self->_dbh;
     $self->_populate_dbh if !$self->_dbh;
     if($want_array) {
-        @result = $coderef->($self->_dbh, @_);
+        @result = $coderef->($self, $self->_dbh, @_);
     }
     elsif(defined $want_array) {
-        $result[0] = $coderef->($self->_dbh, @_);
+        $result[0] = $coderef->($self, $self->_dbh, @_);
     }
     else {
-        $coderef->($self->_dbh, @_);
+        $coderef->($self, $self->_dbh, @_);
     }
   };
 
@@ -505,7 +512,7 @@ sub dbh_do {
   # We were not connected - reconnect and retry, but let any
   #  exception fall right through this time
   $self->_populate_dbh;
-  $coderef->($self->_dbh, @_);
+  $coderef->($self, $self->_dbh, @_);
 }
 
 # This is basically a blend of dbh_do above and DBIx::Class::Storage::txn_do.
@@ -520,54 +527,51 @@ sub txn_do {
 
   local $self->{_in_txn_do} = 1;
 
-  my $tried = 0;
-
   my @result;
   my $want_array = wantarray;
 
-  START_TXN: eval {
-    $self->_verify_pid if $self->_dbh;
-    $self->_populate_dbh if !$self->_dbh;
-
-    $self->txn_begin;
-    if($want_array) {
-        @result = $coderef->(@_);
-    }
-    elsif(defined $want_array) {
-        $result[0] = $coderef->(@_);
-    }
-    else {
-        $coderef->(@_);
-    }
-    $self->txn_commit;
-  };
+  my $tried = 0;
+  while(1) {
+    eval {
+      $self->_verify_pid if $self->_dbh;
+      $self->_populate_dbh if !$self->_dbh;
 
-  my $exception = $@;
-  if(!$exception) { return $want_array ? @result : $result[0] }
+      $self->txn_begin;
+      if($want_array) {
+          @result = $coderef->(@_);
+      }
+      elsif(defined $want_array) {
+          $result[0] = $coderef->(@_);
+      }
+      else {
+          $coderef->(@_);
+      }
+      $self->txn_commit;
+    };
 
-  if($tried++ > 0 || $self->connected) {
-    eval { $self->txn_rollback };
-    my $rollback_exception = $@;
-    if($rollback_exception) {
-      my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
-      $self->throw_exception($exception)  # propagate nested rollback
-        if $rollback_exception =~ /$exception_class/;
-
-      $self->throw_exception(
-        "Transaction aborted: ${exception}. "
-        . "Rollback failed: ${rollback_exception}"
-      );
+    my $exception = $@;
+    if(!$exception) { return $want_array ? @result : $result[0] }
+
+    if($tried++ > 0 || $self->connected) {
+      eval { $self->txn_rollback };
+      my $rollback_exception = $@;
+      if($rollback_exception) {
+        my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
+        $self->throw_exception($exception)  # propagate nested rollback
+          if $rollback_exception =~ /$exception_class/;
+
+        $self->throw_exception(
+          "Transaction aborted: ${exception}. "
+          . "Rollback failed: ${rollback_exception}"
+        );
+      }
+      $self->throw_exception($exception)
     }
-    $self->throw_exception($exception)
-  }
 
-  # We were not connected, and was first try - reconnect and retry
-  # XXX I know, gotos are evil.  If you can find a better way
-  #  to write this that doesn't duplicate a lot of code/structure,
-  #  and behaves identically, feel free...
-
-  $self->_populate_dbh;
-  goto START_TXN;
+    # We were not connected, and was first try - reconnect and retry
+    # via the while loop
+    $self->_populate_dbh;
+  }
 }
 
 =head2 disconnect
@@ -708,8 +712,8 @@ sub _connect {
   $dbh;
 }
 
-sub __txn_begin {
-  my ($dbh, $self) = @_;
+sub _dbh_txn_begin {
+  my ($self, $dbh) = @_;
   if ($dbh->{AutoCommit}) {
     $self->debugobj->txn_begin()
       if ($self->debug);
@@ -719,12 +723,12 @@ sub __txn_begin {
 
 sub txn_begin {
   my $self = shift;
-  $self->dbh_do(\&__txn_begin, $self)
+  $self->dbh_do($self->can('_dbh_txn_begin'))
     if $self->{transaction_depth}++ == 0;
 }
 
-sub __txn_commit {
-  my ($dbh, $self) = @_;
+sub _dbh_txn_commit {
+  my ($self, $dbh) = @_;
   if ($self->{transaction_depth} == 0) {
     unless ($dbh->{AutoCommit}) {
       $self->debugobj->txn_commit()
@@ -743,11 +747,11 @@ sub __txn_commit {
 
 sub txn_commit {
   my $self = shift;
-  $self->dbh_do(\&__txn_commit, $self);
+  $self->dbh_do($self->can('_dbh_txn_commit'));
 }
 
-sub __txn_rollback {
-  my ($dbh, $self) = @_;
+sub _dbh_txn_rollback {
+  my ($self, $dbh) = @_;
   if ($self->{transaction_depth} == 0) {
     unless ($dbh->{AutoCommit}) {
       $self->debugobj->txn_rollback()
@@ -769,7 +773,8 @@ sub __txn_rollback {
 
 sub txn_rollback {
   my $self = shift;
-  eval { $self->dbh_do(\&__txn_rollback, $self) };
+
+  eval { $self->dbh_do($self->can('_dbh_txn_rollback')) };
   if ($@) {
     my $error = $@;
     my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
@@ -895,20 +900,19 @@ Returns a L<DBI> sth (statement handle) for the supplied SQL.
 
 =cut
 
-sub __sth {
-  my ($dbh, $sql) = @_;
+sub _dbh_sth {
+  my ($self, $dbh, $sql) = @_;
   # 3 is the if_active parameter which avoids active sth re-use
   $dbh->prepare_cached($sql, {}, 3);
 }
 
 sub sth {
   my ($self, $sql) = @_;
-  $self->dbh_do(\&__sth, $sql);
+  $self->dbh_do($self->can('_dbh_sth'), $sql);
 }
 
-
-sub __columns_info_for {
-  my ($dbh, $self, $table) = @_;
+sub _dbh_columns_info_for {
+  my ($self, $dbh, $table) = @_;
 
   if ($dbh->can('column_info')) {
     my %result;
@@ -960,7 +964,7 @@ sub __columns_info_for {
 
 sub columns_info_for {
   my ($self, $table) = @_;
-  $self->dbh_do(\&__columns_info_for, $self, $table);
+  $self->dbh_do($self->can('_dbh_columns_info_for'), $table);
 }
 
 =head2 last_insert_id
@@ -969,10 +973,15 @@ Return the row id of the last insert.
 
 =cut
 
+sub _dbh_last_insert_id {
+    my ($self, $dbh, $source, $col) = @_;
+    # XXX This is a SQLite-ism as a default... is there a DBI-generic way?
+    $dbh->func('last_insert_rowid');
+}
+
 sub last_insert_id {
-  my ($self, $row) = @_;
-    
-  $self->dbh_do(sub { shift->func('last_insert_rowid') });
+  my $self = shift;
+  $self->dbh_do($self->can('_dbh_last_insert_id'), @_);
 }
 
 =head2 sqlt_type
@@ -981,7 +990,7 @@ Returns the database driver name.
 
 =cut
 
-sub sqlt_type { shift->dbh_do(sub { shift->{Driver}->{Name} }) }
+sub sqlt_type { shift->dbh->{Driver}->{Name} }
 
 =head2 create_ddl_dir (EXPERIMENTAL)
 
diff --git a/lib/DBIx/Class/Storage/DBI/DB2.pm b/lib/DBIx/Class/Storage/DBI/DB2.pm
index ebe1067..4b5051b 100644
--- a/lib/DBIx/Class/Storage/DBI/DB2.pm
+++ b/lib/DBIx/Class/Storage/DBI/DB2.pm
@@ -7,17 +7,15 @@ use base qw/DBIx::Class::Storage::DBI/;
 
 # __PACKAGE__->load_components(qw/PK::Auto/);
 
-sub last_insert_id
-{
-    my ($self) = @_;
+sub _dbh_last_insert_id {
+    my ($self, $dbh, $source, $col) = @_;
 
-    my $sth = $self->dbh_do(sub { shift->prepare_cached("VALUES(IDENTITY_VAL_LOCAL())", {}, 3) });
+    my $sth = $dbh->prepare_cached('VALUES(IDENTITY_VAL_LOCAL())', {}, 3);
     $sth->execute();
 
     my @res = $sth->fetchrow_array();
 
     return @res ? $res[0] : undef;
-                         
 }
 
 sub datetime_parser_type { "DateTime::Format::DB2"; }
diff --git a/lib/DBIx/Class/Storage/DBI/MSSQL.pm b/lib/DBIx/Class/Storage/DBI/MSSQL.pm
index 6634c59..dcfe895 100644
--- a/lib/DBIx/Class/Storage/DBI/MSSQL.pm
+++ b/lib/DBIx/Class/Storage/DBI/MSSQL.pm
@@ -5,10 +5,9 @@ use warnings;
 
 use base qw/DBIx::Class::Storage::DBI/;
 
-sub last_insert_id {
-  my $self = shift;
-  my ($id) =
-    $self->dbh_do( sub { shift->selectrow_array('SELECT @@IDENTITY' ) } );
+sub _dbh_last_insert_id {
+  my ($self, $dbh, $source, $col) = @_;
+  my ($id) = $dbh->selectrow_array('SELECT @@IDENTITY');
   return $id;
 }
 
diff --git a/lib/DBIx/Class/Storage/DBI/ODBC/DB2_400_SQL.pm b/lib/DBIx/Class/Storage/DBI/ODBC/DB2_400_SQL.pm
index e84c087..1df4c21 100644
--- a/lib/DBIx/Class/Storage/DBI/ODBC/DB2_400_SQL.pm
+++ b/lib/DBIx/Class/Storage/DBI/ODBC/DB2_400_SQL.pm
@@ -4,32 +4,32 @@ use warnings;
 
 use base qw/DBIx::Class::Storage::DBI::ODBC/;
 
-sub last_insert_id
-{
-    my ($self) = @_;
-
-    $self->dbh_do(sub {
-        my $dbh = shift;
+sub _dbh_last_insert_id {
+    my ($self, $dbh, $source, $col) = @_;
 
-        # get the schema/table separator:
-        #    '.' when SQL naming is active
-        #    '/' when system naming is active
-        my $sep = $dbh->get_info(41);
-        my $sth = $dbh->prepare_cached(
-            "SELECT IDENTITY_VAL_LOCAL() FROM SYSIBM${sep}SYSDUMMY1", {}, 3);
-        $sth->execute();
+    # get the schema/table separator:
+    #    '.' when SQL naming is active
+    #    '/' when system naming is active
+    my $sep = $dbh->get_info(41);
+    my $sth = $dbh->prepare_cached(
+        "SELECT IDENTITY_VAL_LOCAL() FROM SYSIBM${sep}SYSDUMMY1", {}, 3);
+    $sth->execute();
 
-        my @res = $sth->fetchrow_array();
+    my @res = $sth->fetchrow_array();
 
-        return @res ? $res[0] : undef;
-    });
+    return @res ? $res[0] : undef;
 }
 
 sub _sql_maker_opts {
     my ($self) = @_;
     
     $self->dbh_do(sub {
-        { limit_dialect => 'FetchFirst', name_sep => shift->get_info(41) }
+        my ($self, $dbh) = @_;
+
+        return {
+            limit_dialect => 'FetchFirst',
+            name_sep => $dbh->get_info(41)
+        };
     });
 }
 
diff --git a/lib/DBIx/Class/Storage/DBI/Oracle.pm b/lib/DBIx/Class/Storage/DBI/Oracle.pm
index fa5d67f..77cedf3 100644
--- a/lib/DBIx/Class/Storage/DBI/Oracle.pm
+++ b/lib/DBIx/Class/Storage/DBI/Oracle.pm
@@ -9,20 +9,24 @@ use base qw/DBIx::Class::Storage::DBI::MultiDistinctEmulation/;
 
 # __PACKAGE__->load_components(qw/PK::Auto/);
 
-sub _ora_last_insert_id {
-   my ($dbh, $sql) = @_;
-   $dbh->selectrow_array($sql);
-}
-sub last_insert_id {
-  my ($self,$source,$col) = @_;
+sub _dbh_last_insert_id {
+  my ($self, $dbh, $source, $col) = @_;
   my $seq = ($source->column_info($col)->{sequence} ||= $self->get_autoinc_seq($source,$col));
   my $sql = 'SELECT ' . $seq . '.currval FROM DUAL';
-  my ($id) = $self->dbh_do(\&_ora_last_insert_id($sql));
+  my ($id) = $dbh->selectrow_array($sql);
   return $id;
 }
 
-sub _ora_get_autoinc_seq {
-  my ($dbh, $source, $sql) = @_;
+sub _dbh_get_autoinc_seq {
+  my ($self, $dbh, $source, $col) = @_;
+
+  # look up the correct sequence automatically
+  my $sql = q{
+    SELECT trigger_body FROM ALL_TRIGGERS t
+    WHERE t.table_name = ?
+    AND t.triggering_event = 'INSERT'
+    AND t.status = 'ENABLED'
+  };
 
   # trigger_body is a LONG
   $dbh->{LongReadLen} = 64 * 1024 if ($dbh->{LongReadLen} < 64 * 1024);
@@ -36,17 +40,9 @@ sub _ora_get_autoinc_seq {
 }
 
 sub get_autoinc_seq {
-  my ($self,$source,$col) = @_;
+  my ($self, $source, $col) = @_;
     
-  # look up the correct sequence automatically
-  my $sql = q{
-    SELECT trigger_body FROM ALL_TRIGGERS t
-    WHERE t.table_name = ?
-    AND t.triggering_event = 'INSERT'
-    AND t.status = 'ENABLED'
-  };
-
-  $self->dbh_do(\&_ora_get_autoinc_seq, $source, $sql);
+  $self->dbh_do($self->can('_dbh_get_autoinc_seq'), $source, $col);
 }
 
 sub columns_info_for {
diff --git a/lib/DBIx/Class/Storage/DBI/Pg.pm b/lib/DBIx/Class/Storage/DBI/Pg.pm
index d8ed989..0c98f91 100644
--- a/lib/DBIx/Class/Storage/DBI/Pg.pm
+++ b/lib/DBIx/Class/Storage/DBI/Pg.pm
@@ -13,19 +13,19 @@ use base qw/DBIx::Class::Storage::DBI/;
 warn "DBD::Pg 1.49 is strongly recommended"
   if ($DBD::Pg::VERSION < 1.49);
 
-sub _pg_last_insert_id {
-  my ($dbh, $seq) = @_;
-  $dbh->last_insert_id(undef,undef,undef,undef, {sequence => $seq});
+sub _dbh_last_insert_id {
+  my ($self, $dbh, $seq) = @_;
+  $dbh->last_insert_id(undef, undef, undef, undef, {sequence => $seq});
 }
 
 sub last_insert_id {
   my ($self,$source,$col) = @_;
   my $seq = ($source->column_info($col)->{sequence} ||= $self->get_autoinc_seq($source,$col));
-  $self->dbh_do(\&_pg_last_insert_id, $seq);
+  $self->dbh_do($self->can('_dbh_last_insert_id'), $seq);
 }
 
-sub _pg_get_autoinc_seq {
-  my ($dbh, $schema, $table, @pri) = @_;
+sub _dbh_get_autoinc_seq {
+  my ($self, $dbh, $schema, $table, @pri) = @_;
 
   while (my $col = shift @pri) {
     my $info = $dbh->column_info(undef,$schema,$table,$col)->fetchrow_hashref;
@@ -46,7 +46,7 @@ sub get_autoinc_seq {
   my ($schema,$table) = $source->name =~ /^(.+)\.(.+)$/ ? ($1,$2)
     : (undef,$source->name);
 
-  $self->dbh_do(\&_pg_get_autoinc_seq, $schema, $table, @pri);
+  $self->dbh_do($self->can('_dbh_get_autoinc_seq'), $schema, $table, @pri);
 }
 
 sub sqlt_type {
diff --git a/lib/DBIx/Class/Storage/DBI/SQLite.pm b/lib/DBIx/Class/Storage/DBI/SQLite.pm
index ccf82d5..2d7d9ad 100644
--- a/lib/DBIx/Class/Storage/DBI/SQLite.pm
+++ b/lib/DBIx/Class/Storage/DBI/SQLite.pm
@@ -5,8 +5,9 @@ use warnings;
 
 use base qw/DBIx::Class::Storage::DBI::MultiDistinctEmulation/;
 
-sub last_insert_id {
-  shift->dbh_do(sub { shift->func('last_insert_rowid') });
+sub _dbh_last_insert_id {
+  my ($self, $dbh, $source, $col) = @_;
+  $dbh->func('last_insert_rowid');
 }
 
 1;
diff --git a/lib/DBIx/Class/Storage/DBI/mysql.pm b/lib/DBIx/Class/Storage/DBI/mysql.pm
index 2f1114b..8ecdfca 100644
--- a/lib/DBIx/Class/Storage/DBI/mysql.pm
+++ b/lib/DBIx/Class/Storage/DBI/mysql.pm
@@ -7,8 +7,9 @@ use base qw/DBIx::Class::Storage::DBI/;
 
 # __PACKAGE__->load_components(qw/PK::Auto/);
 
-sub last_insert_id {
-  return shift->dbh_do(sub { shift->{mysql_insertid} } );
+sub _dbh_last_insert_id {
+  my ($self, $dbh, $source, $col) = @_;
+  $dbh->{mysql_insertid};
 }
 
 sub sqlt_type {