arrayrefs for on_connect_do
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI.pm
index cde6ac5..3338b93 100644 (file)
@@ -13,10 +13,12 @@ use Scalar::Util qw/blessed weaken/;
 
 __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/
+       _conn_pid _conn_tid disable_sth_caching on_connect_do
+       on_disconnect_do transaction_depth unsafe _dbh_autocommit/
 );
 
+__PACKAGE__->cursor_class('DBIx::Class::Storage::DBI::Cursor');
+
 BEGIN {
 
 package DBIC::SQL::Abstract; # Would merge upstream, but nate doesn't reply :(
@@ -311,7 +313,6 @@ documents DBI-specific methods and behaviors.
 sub new {
   my $new = shift->next::method(@_);
 
-  $new->cursor("DBIx::Class::Storage::DBI::Cursor");
   $new->transaction_depth(0);
   $new->_sql_maker_opts({});
   $new->{_in_dbh_do} = 0;
@@ -346,9 +347,30 @@ connection-specific options:
 
 =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.
+Specifies things to do immediately after connecting or re-connecting to
+the database.  Its value may contain:
+
+=over
+
+=item an array reference
+
+This contains SQL statements to execute in order.  Each element contains
+a string or a code reference that returns a string.
+
+=item a code reference
+
+This contains some code to execute.  Unlike code references within an
+array reference, its return value is ignored.
+
+=back
+
+=item on_disconnect_do
+
+Takes arguments in the same for as L<on_connect_do> and executes them
+immediately before disconnecting from the database.
+
+Note, this only runs if you explicitly call L<disconnect> on the
+storage object.
 
 =item disable_sth_caching
 
@@ -479,7 +501,11 @@ sub connect_info {
 
   my $last_info = $dbi_info->[-1];
   if(ref $last_info eq 'HASH') {
-    for my $storage_opt (qw/on_connect_do disable_sth_caching unsafe/) {
+    $last_info = { %$last_info }; # so delete is non-destructive
+    my @storage_option = qw(
+      on_connect_do on_disconnect_do disable_sth_caching unsafe cursor_class
+    );
+    for my $storage_opt (@storage_option) {
       if(my $value = delete $last_info->{$storage_opt}) {
         $self->$storage_opt($value);
       }
@@ -489,6 +515,8 @@ sub connect_info {
         $self->_sql_maker_opts->{$sql_maker_opt} = $opt_val;
       }
     }
+    # re-insert modified hashref
+    $dbi_info->[-1] = $last_info;
 
     # Get rid of any trailing empty hashref
     pop(@$dbi_info) if !keys %$last_info;
@@ -582,6 +610,8 @@ sub txn_do {
   ref $coderef eq 'CODE' or $self->throw_exception
     ('$coderef must be a CODE reference');
 
+  return $coderef->(@_) if $self->{transaction_depth};
+
   local $self->{_in_dbh_do} = 1;
 
   my @result;
@@ -642,7 +672,10 @@ sub disconnect {
   my ($self) = @_;
 
   if( $self->connected ) {
-    $self->_dbh->rollback unless $self->_dbh->{AutoCommit};
+    my $connection_do = $self->on_disconnect_do;
+    $self->_do_connection_actions($connection_do) if ref($connection_do);
+
+    $self->_dbh->rollback unless $self->_dbh_autocommit;
     $self->_dbh->disconnect;
     $self->_dbh(undef);
     $self->{_dbh_gen}++;
@@ -660,6 +693,7 @@ sub connected {
       }
       else {
           $self->_verify_pid;
+          return 0 if !$self->_dbh;
       }
       return ($dbh->FETCH('Active') && $dbh->ping);
   }
@@ -723,7 +757,7 @@ sub _populate_dbh {
 
   # Always set the transaction depth on connect, since
   #  there is no transaction in progress by definition
-  $self->{transaction_depth} = $self->_dbh->{AutoCommit} ? 0 : 1;
+  $self->{transaction_depth} = $self->_dbh_autocommit ? 0 : 1;
 
   if(ref $self eq 'DBIx::Class::Storage::DBI') {
     my $driver = $self->_dbh->{Driver}->{Name};
@@ -733,17 +767,43 @@ sub _populate_dbh {
     }
   }
 
-  # 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();
-  }
+  my $connection_do = $self->on_connect_do;
+  $self->_do_connection_actions($connection_do) if ref($connection_do);
 
   $self->_conn_pid($$);
   $self->_conn_tid(threads->tid) if $INC{'threads.pm'};
 }
 
+sub _do_connection_actions {
+  my $self = shift;
+  my $connection_do = shift;
+
+  if (ref $connection_do eq 'ARRAY') {
+    $self->_do_query($_) foreach @$connection_do;
+  }
+  elsif (ref $connection_do eq 'CODE') {
+    $connection_do->();
+  }
+
+  return $self;
+}
+
+sub _do_query {
+  my ($self, $action) = @_;
+
+  if (ref $action eq 'CODE') {
+    $action->($self);
+  }
+  else {
+    my @to_run = (ref $action eq 'ARRAY') ? (@$action) : ($action);
+    $self->_query_start(@to_run);
+    $self->_dbh->do(@to_run);
+    $self->_query_end(@to_run);
+  }
+
+  return $self;
+}
+
 sub _connect {
   my ($self, @info) = @_;
 
@@ -765,7 +825,7 @@ sub _connect {
        $dbh = DBI->connect(@info);
     }
 
-    if(!$self->unsafe) {
+    if($dbh && !$self->unsafe) {
       my $weak_self = $self;
       weaken($weak_self);
       $dbh->{HandleError} = sub {
@@ -782,6 +842,8 @@ sub _connect {
   $self->throw_exception("DBI Connection failed: " . ($@||$DBI::errstr))
     if !$dbh || $@;
 
+  $self->_dbh_autocommit($dbh->{AutoCommit});
+
   $dbh;
 }
 
@@ -789,7 +851,7 @@ sub _connect {
 sub txn_begin {
   my $self = shift;
   $self->ensure_connected();
-  if($self->{transaction_depth}++ == 0) {
+  if($self->{transaction_depth} == 0) {
     $self->debugobj->txn_begin()
       if $self->debug;
     # this isn't ->_dbh-> because
@@ -797,6 +859,7 @@ sub txn_begin {
     #  for AutoCommit users
     $self->dbh->begin_work;
   }
+  $self->{transaction_depth}++;
 }
 
 sub txn_commit {
@@ -807,7 +870,7 @@ sub txn_commit {
       if ($self->debug);
     $dbh->commit;
     $self->{transaction_depth} = 0
-      if $dbh->{AutoCommit};
+      if $self->_dbh_autocommit;
   }
   elsif($self->{transaction_depth} > 1) {
     $self->{transaction_depth}--
@@ -817,15 +880,13 @@ sub txn_commit {
 sub txn_rollback {
   my $self = shift;
   my $dbh = $self->_dbh;
-  my $autocommit;
   eval {
-    $autocommit = $dbh->{AutoCommit};
     if ($self->{transaction_depth} == 1) {
       $self->debugobj->txn_rollback()
         if ($self->debug);
-      $dbh->rollback;
       $self->{transaction_depth} = 0
-        if $autocommit;
+        if $self->_dbh_autocommit;
+      $dbh->rollback;
     }
     elsif($self->{transaction_depth} > 1) {
       $self->{transaction_depth}--;
@@ -839,7 +900,7 @@ sub txn_rollback {
     my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
     $error =~ /$exception_class/ and $self->throw_exception($error);
     # ensure that a failed rollback resets the transaction depth
-    $self->{transaction_depth} = $autocommit ? 0 : 1;
+    $self->{transaction_depth} = $self->_dbh_autocommit ? 0 : 1;
     $self->throw_exception($error);
   }
 }
@@ -858,6 +919,40 @@ sub _prep_for_execute {
   return ($sql, \@bind);
 }
 
+sub _fix_bind_params {
+    my ($self, @bind) = @_;
+
+    ### Turn @bind from something like this:
+    ###   ( [ "artist", 1 ], [ "cdid", 1, 3 ] )
+    ### to this:
+    ###   ( "'1'", "'1'", "'3'" )
+    return
+        map {
+            if ( defined( $_ && $_->[1] ) ) {
+                map { qq{'$_'}; } @{$_}[ 1 .. $#$_ ];
+            }
+            else { q{'NULL'}; }
+        } @bind;
+}
+
+sub _query_start {
+    my ( $self, $sql, @bind ) = @_;
+
+    if ( $self->debug ) {
+        @bind = $self->_fix_bind_params(@bind);
+        $self->debugobj->query_start( $sql, @bind );
+    }
+}
+
+sub _query_end {
+    my ( $self, $sql, @bind ) = @_;
+
+    if ( $self->debug ) {
+        @bind = $self->_fix_bind_params(@bind);
+        $self->debugobj->query_end( $sql, @bind );
+    }
+}
+
 sub _dbh_execute {
   my ($self, $dbh, $op, $extra_bind, $ident, $bind_attributes, @args) = @_;
   
@@ -867,11 +962,7 @@ sub _dbh_execute {
 
   my ($sql, $bind) = $self->_prep_for_execute($op, $extra_bind, $ident, \@args);
 
-  if ($self->debug) {
-      my @debug_bind =
-        map { defined ($_ && $_->[1]) ? qq{'$_->[1]'} : q{'NULL'} } @$bind;
-      $self->debugobj->query_start($sql, @debug_bind);
-  }
+  $self->_query_start( $sql, @$bind );
 
   my $sth = $self->sth($sql,$op);
 
@@ -898,11 +989,7 @@ sub _dbh_execute {
   my $rv = $sth->execute();
   $self->throw_exception($sth->errstr) if !$rv;
 
-  if ($self->debug) {
-     my @debug_bind =
-       map { defined ($_ && $_->[1]) ? qq{'$_->[1]'} : q{'NULL'} } @$bind; 
-     $self->debugobj->query_end($sql, @debug_bind);
-  }
+  $self->_query_end( $sql, @$bind );
 
   return (wantarray ? ($rv, $sth, @$bind) : $rv);
 }
@@ -934,10 +1021,7 @@ sub insert_bulk {
   @colvalues{@$cols} = (0..$#$cols);
   my ($sql, @bind) = $self->sql_maker->insert($table, \%colvalues);
   
-  if ($self->debug) {
-      my @debug_bind = map { defined $_->[1] ? qq{$_->[1]} : q{'NULL'} } @bind;
-      $self->debugobj->query_start($sql, @debug_bind);
-  }
+  $self->_query_start( $sql, @bind );
   my $sth = $self->sth($sql);
 
 #  @bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args
@@ -975,10 +1059,7 @@ sub insert_bulk {
   my $rv = $sth->execute_array({ArrayTupleStatus => $tuple_status});
   $self->throw_exception($sth->errstr) if !$rv;
 
-  if ($self->debug) {
-      my @debug_bind = map { defined $_ ? qq{`$_'} : q{`NULL'} } @bind;
-      $self->debugobj->query_end($sql, @debug_bind);
-  }
+  $self->_query_end( $sql, @bind );
   return (wantarray ? ($rv, $sth, @bind) : $rv);
 }
 
@@ -1055,7 +1136,7 @@ Handle a SQL select statement.
 sub select {
   my $self = shift;
   my ($ident, $select, $condition, $attrs) = @_;
-  return $self->cursor->new($self, \@_, $attrs);
+  return $self->cursor_class->new($self, \@_, $attrs);
 }
 
 sub select_single {
@@ -1408,14 +1489,14 @@ sub deploy {
       next if($line =~ /^BEGIN TRANSACTION/m);
       next if($line =~ /^COMMIT/m);
       next if $line =~ /^\s+$/; # skip whitespace only
-      $self->debugobj->query_start($line) if $self->debug;
+      $self->_query_start($line);
       eval {
         $self->dbh->do($line); # shouldn't be using ->dbh ?
       };
       if ($@) {
         warn qq{$@ (running "${line}")};
       }
-      $self->debugobj->query_end($line) if $self->debug;
+      $self->_query_end($line);
     }
   }
 }