Merge 'trunk' into 'DBIx-Class-current'
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI.pm
index 41b30a0..14a8f61 100644 (file)
@@ -3,18 +3,19 @@ package DBIx::Class::Storage::DBI;
 
 use base 'DBIx::Class::Storage';
 
-use strict;
+use strict;    
 use warnings;
 use DBI;
 use SQL::Abstract::Limit;
 use DBIx::Class::Storage::DBI::Cursor;
 use DBIx::Class::Storage::Statistics;
 use IO::File;
+use Scalar::Util 'blessed';
 
-__PACKAGE__->mk_group_accessors(
-  'simple' =>
-    qw/_connect_info _dbh _sql_maker _sql_maker_opts _conn_pid _conn_tid
-       disable_sth_caching cursor on_connect_do transaction_depth/
+__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/
 );
 
 BEGIN {
@@ -330,7 +331,13 @@ C<connect_info> here.
 
 The arrayref can either contain the same set of arguments one would
 normally pass to L<DBI/connect>, or a lone code reference which returns
-a connected database handle.
+a connected database handle.  Please note that the L<DBI> docs
+recommend that you always explicitly set C<AutoCommit> to either
+C<0> or C<1>.   L<DBIx::Class> further recommends that it be set
+to C<1>, and that you perform transactions via our L</txn_do>
+method.  L<DBIx::Class> will set it to C<1> if you do not do explicitly
+set it to zero.  This is the default for most DBDs.  See below for more
+details.
 
 In either case, if the final argument in your connect_info happens
 to be a hashref, C<connect_info> will look there for several
@@ -389,6 +396,21 @@ might not work very well, YMMV.  If you don't use a subref, DBIC will
 force this setting for you anyways.  Setting HandleError to anything
 other than simple exception object wrapper might cause problems too.
 
+Another Important Note:
+
+DBIC can do some wonderful magic with handling exceptions,
+disconnections, and transactions when you use C<AutoCommit =&gt; 1>
+combined with C<txn_do> for transaction support.
+
+If you set C<AutoCommit =&gt; 0> in your connect info, then you are always
+in an assumed transaction between commits, and you're telling us you'd
+like to manage that manually.  A lot of DBIC's magic protections
+go away.  We can't protect you from exceptions due to database
+disconnects because we don't know anything about how to restart your
+transactions.  You're on your own for handling all sorts of exceptional
+cases if you choose the C<AutoCommit =&gt 0> path, just as you would
+be with raw DBI.
+
 Examples:
 
   # Simple SQLite connection
@@ -403,7 +425,7 @@ Examples:
       'dbi:Pg:dbname=foo',
       'postgres',
       'my_pg_password',
-      { AutoCommit => 0 },
+      { AutoCommit => 1 },
       { quote_char => q{"}, name_sep => q{.} },
     ]
   );
@@ -414,7 +436,7 @@ Examples:
       'dbi:Pg:dbname=foo',
       'postgres',
       'my_pg_password',
-      { AutoCommit => 0, quote_char => q{"}, name_sep => q{.} },
+      { AutoCommit => 1, quote_char => q{"}, name_sep => q{.} },
     ]
   );
 
@@ -442,9 +464,11 @@ sub connect_info {
   #  the new set of options
   $self->_sql_maker(undef);
   $self->_sql_maker_opts({});
+  $self->_connect_info([@$info_arg]); # copy for _connect_info
 
-  my $info = [ @$info_arg ]; # copy because we can alter it
-  my $last_info = $info->[-1];
+  my $dbi_info = [@$info_arg]; # copy for _dbi_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/) {
       if(my $value = delete $last_info->{$storage_opt}) {
@@ -458,10 +482,11 @@ sub connect_info {
     }
 
     # Get rid of any trailing empty hashref
-    pop(@$info) if !keys %$last_info;
+    pop(@$dbi_info) if !keys %$last_info;
   }
+  $self->_dbi_connect_info($dbi_info);
 
-  $self->_connect_info($info);
+  $self->_connect_info;
 }
 
 =head2 on_connect_do
@@ -505,7 +530,9 @@ sub dbh_do {
   ref $coderef eq 'CODE' or $self->throw_exception
     ('$coderef must be a CODE reference');
 
-  return $coderef->($self, $self->_dbh, @_) if $self->{_in_dbh_do};
+  return $coderef->($self, $self->_dbh, @_) if $self->{_in_dbh_do}
+      || $self->{transaction_depth};
+
   local $self->{_in_dbh_do} = 1;
 
   my @result;
@@ -682,9 +709,13 @@ sub sql_maker {
 
 sub _populate_dbh {
   my ($self) = @_;
-  my @info = @{$self->_connect_info || []};
+  my @info = @{$self->_dbi_connect_info || []};
   $self->_dbh($self->_connect(@info));
 
+  # Always set the transaction depth on connect, since
+  #  there is no transaction in progress by definition
+  $self->{transaction_depth} = $self->_dbh->{AutoCommit} ? 0 : 1;
+
   if(ref $self eq 'DBIx::Class::Storage::DBI') {
     my $driver = $self->_dbh->{Driver}->{Name};
     if ($self->load_optional_class("DBIx::Class::Storage::DBI::${driver}")) {
@@ -738,75 +769,61 @@ sub _connect {
   $dbh;
 }
 
-sub _dbh_txn_begin {
-  my ($self, $dbh) = @_;
-  if ($dbh->{AutoCommit}) {
-    $self->debugobj->txn_begin()
-      if ($self->debug);
-    $dbh->begin_work;
-  }
-}
 
 sub txn_begin {
   my $self = shift;
-  $self->dbh_do($self->can('_dbh_txn_begin'))
-    if $self->{transaction_depth}++ == 0;
-}
-
-sub _dbh_txn_commit {
-  my ($self, $dbh) = @_;
-  if ($self->{transaction_depth} == 0) {
-    unless ($dbh->{AutoCommit}) {
-      $self->debugobj->txn_commit()
-        if ($self->debug);
-      $dbh->commit;
-    }
-  }
-  else {
-    if (--$self->{transaction_depth} == 0) {
-      $self->debugobj->txn_commit()
-        if ($self->debug);
-      $dbh->commit;
-    }
+  if($self->{transaction_depth}++ == 0) {
+    $self->debugobj->txn_begin()
+      if $self->debug;
+    # this isn't ->_dbh-> because
+    #  we should reconnect on begin_work
+    #  for AutoCommit users
+    $self->dbh->begin_work;
   }
 }
 
 sub txn_commit {
   my $self = shift;
-  $self->dbh_do($self->can('_dbh_txn_commit'));
+  if ($self->{transaction_depth} == 1) {
+    my $dbh = $self->_dbh;
+    $self->debugobj->txn_commit()
+      if ($self->debug);
+    $dbh->commit;
+    $self->{transaction_depth} = 0
+      if $dbh->{AutoCommit};
+  }
+  elsif($self->{transaction_depth} > 1) {
+    $self->{transaction_depth}--
+  }
 }
 
-sub _dbh_txn_rollback {
-  my ($self, $dbh) = @_;
-  if ($self->{transaction_depth} == 0) {
-    unless ($dbh->{AutoCommit}) {
+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;
     }
-  }
-  else {
-    if (--$self->{transaction_depth} == 0) {
-      $self->debugobj->txn_rollback()
-        if ($self->debug);
-      $dbh->rollback;
+    elsif($self->{transaction_depth} > 1) {
+      $self->{transaction_depth}--;
     }
     else {
       die DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION->new;
     }
-  }
-}
-
-sub txn_rollback {
-  my $self = shift;
-
-  eval { $self->dbh_do($self->can('_dbh_txn_rollback')) };
+  };
   if ($@) {
     my $error = $@;
     my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
     $error =~ /$exception_class/ and $self->throw_exception($error);
-    $self->{transaction_depth} = 0;          # ensure that a failed rollback
-    $self->throw_exception($error);          # resets the transaction depth
+    # ensure that a failed rollback resets the transaction depth
+    $self->{transaction_depth} = $autocommit ? 0 : 1;
+    $self->throw_exception($error);
   }
 }
 
@@ -817,7 +834,9 @@ sub _prep_for_execute {
   my ($self, $op, $extra_bind, $ident, @args) = @_;
 
   my ($sql, @bind) = $self->sql_maker->$op($ident, @args);
-  unshift(@bind, @$extra_bind) if $extra_bind;
+  unshift(@bind,
+    map { ref $_ eq 'ARRAY' ? $_ : [ '!!dummy', $_ ] } @$extra_bind)
+      if $extra_bind;
   @bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args
 
   return ($sql, @bind);
@@ -826,52 +845,68 @@ sub _prep_for_execute {
 sub _execute {
   my ($self, $op, $extra_bind, $ident, $bind_attributes, @args) = @_;
   
+  if( blessed($ident) && $ident->isa("DBIx::Class::ResultSource") ) {
+    $ident = $ident->from();
+  }
+  
   my ($sql, @bind) = $self->sql_maker->$op($ident, @args);
-  unshift(@bind, @$extra_bind) if $extra_bind;
+  unshift(@bind,
+    map { ref $_ eq 'ARRAY' ? $_ : [ '!!dummy', $_ ] } @$extra_bind)
+      if $extra_bind;
   if ($self->debug) {
-      my @debug_bind = map { defined ($_ && $_->[1]) ? qq{'$_->[1]'} : q{'NULL'} } @bind;
+      my @debug_bind =
+        map { defined ($_ && $_->[1]) ? qq{'$_->[1]'} : q{'NULL'} } @bind;
       $self->debugobj->query_start($sql, @debug_bind);
   }
-  my $sth = eval { $self->sth($sql,$op) };
 
-  if (!$sth || $@) {
-    $self->throw_exception(
-      'no sth generated via sql (' . ($@ || $self->_dbh->errstr) . "): $sql"
-    );
-  }
+  my ($rv, $sth);
+  RETRY: while (1) {
+    $sth = eval { $self->sth($sql,$op) };
 
-  my $rv;
-  if ($sth) {
-    my $time = time();
-       
-    $rv = eval {
-       
-      my $placeholder_index = 1; 
+    if (!$sth || $@) {
+      $self->throw_exception(
+        'no sth generated via sql (' . ($@ || $self->_dbh->errstr) . "): $sql"
+      );
+    }
 
-      foreach my $bound (@bind) {
+    if ($sth) {
+      my $time = time();
+      $rv = eval {
+        my $placeholder_index = 1; 
 
-        my $attributes = {};
-        my($column_name, $data) = @$bound;
+        foreach my $bound (@bind) {
 
-        if( $bind_attributes ) {
-          $attributes = $bind_attributes->{$column_name}
-          if defined $bind_attributes->{$column_name};
-        }                      
+          my $attributes = {};
+          my($column_name, @data) = @$bound;
 
-        $data = ref $data ? ''.$data : $data; # stringify args
+          if( $bind_attributes ) {
+            $attributes = $bind_attributes->{$column_name}
+            if defined $bind_attributes->{$column_name};
+          }
+
+          foreach my $data (@data)
+          {
+            $data = ref $data ? ''.$data : $data; # stringify args
 
-        $sth->bind_param($placeholder_index, $data, $attributes);
-        $placeholder_index++;
+            $sth->bind_param($placeholder_index, $data, $attributes);
+            $placeholder_index++;
+          }
+        }
+        $sth->execute();
+      };
+    
+      if ($@ || !$rv) {
+        $self->throw_exception("Error executing '$sql': ".($@ || $sth->errstr))
+          if $self->connected;
+        $self->_populate_dbh;
+      } else {
+        last RETRY;
       }
-      $sth->execute;
-    };
-  
-    if ($@ || !$rv) {
-      $self->throw_exception("Error executing '$sql': ".($@ || $sth->errstr));
+    } else {
+      $self->throw_exception("'$sql' did not generate a statement.");
     }
-  } else {
-    $self->throw_exception("'$sql' did not generate a statement.");
-  }
+  } # While(1) to retry if disconencted
+
   if ($self->debug) {
      my @debug_bind =
        map { defined ($_ && $_->[1]) ? qq{'$_->[1]'} : q{'NULL'} } @bind; 
@@ -884,19 +919,13 @@ sub insert {
   my ($self, $source, $to_insert) = @_;
   
   my $ident = $source->from; 
-  my $bind_attributes;
-  foreach my $column ($source->columns) {
-  
-    my $data_type = $source->column_info($column)->{data_type} || '';
-    $bind_attributes->{$column} = $self->bind_attribute_by_data_type($data_type)
-        if $data_type;
-  } 
-  
+  my $bind_attributes = $self->source_bind_attributes($source);
+
   $self->throw_exception(
     "Couldn't insert ".join(', ',
       map "$_ => $to_insert->{$_}", keys %$to_insert
     )." into ${ident}"
-  ) unless ($self->_execute('insert' => [], $ident, $bind_attributes, $to_insert));
+  ) unless ($self->_execute('insert' => [], $source, $bind_attributes, $to_insert));
   return $to_insert;
 }
 
@@ -927,41 +956,17 @@ sub insert_bulk {
   
   ##use Data::Dumper;
   ##print STDERR Dumper( $data, $sql, [@bind] );
-       
+
   if ($sth) {
   
     my $time = time();
-       
-    #$rv = eval {
-       #
-       #  $sth->execute_array({
-
-       #    ArrayTupleFetch => sub {
-
-       #      my $values = shift @$data;  
-    #      return if !$values; 
-    #      return [ @{$values}[@bind] ];
-       #    },
-         
-       #    ArrayTupleStatus => $tuple_status,
-       #  })
-    #};
-       
-       ## Get the bind_attributes, if any exist
-       
-    my $bind_attributes;
-    foreach my $column ($source->columns) {
-  
-      my $data_type = $source->column_info($column)->{data_type} || '';
-         
-      $bind_attributes->{$column} = $self->bind_attribute_by_data_type($data_type)
-          if $data_type;
-    } 
-       
-       ## Bind the values and execute
-       
-       $rv = eval {
-       
+
+    ## Get the bind_attributes, if any exist
+    my $bind_attributes = $self->source_bind_attributes($source);
+
+    ## Bind the values and execute
+    $rv = eval {
+
      my $placeholder_index = 1; 
 
         foreach my $bound (@bind) {
@@ -973,23 +978,19 @@ sub insert_bulk {
             $attributes = $bind_attributes->{$column_name}
             if defined $bind_attributes->{$column_name};
           }
-                 
-                 my @data = map { $_->[$data_index] } @$data;
+
+          my @data = map { $_->[$data_index] } @$data;
 
           $sth->bind_param_array( $placeholder_index, [@data], $attributes );
           $placeholder_index++;
       }
-         $sth->execute_array( {ArrayTupleStatus => $tuple_status} );
+      $sth->execute_array( {ArrayTupleStatus => $tuple_status} );
 
-       };
+    };
    
-#print STDERR Dumper($tuple_status);
-#print STDERR "RV: $rv\n";
-
     if ($@ || !defined $rv) {
       my $errors = '';
-      foreach my $tuple (@$tuple_status)
-      {
+      foreach my $tuple (@$tuple_status) {
           $errors .= "\n" . $tuple->[1] if(ref $tuple);
       }
       $self->throw_exception("Error executing '$sql': ".($@ || $errors));
@@ -1007,17 +1008,9 @@ sub insert_bulk {
 sub update {
   my $self = shift @_;
   my $source = shift @_;
+  my $bind_attributes = $self->source_bind_attributes($source);
   
-  my $bind_attributes;
-  foreach my $column ($source->columns) {
-  
-    my $data_type = $source->column_info($column)->{data_type} || '';
-    $bind_attributes->{$column} = $self->bind_attribute_by_data_type($data_type)
-        if $data_type;
-  }
-
-  my $ident = $source->from;
-  return $self->_execute('update' => [], $ident, $bind_attributes, @_);
+  return $self->_execute('update' => [], $source, $bind_attributes, @_);
 }
 
 
@@ -1026,9 +1019,8 @@ sub delete {
   my $source = shift @_;
   
   my $bind_attrs = {}; ## If ever it's needed...
-  my $ident = $source->from;
   
-  return $self->_execute('delete' => [], $ident, $bind_attrs, @_);
+  return $self->_execute('delete' => [], $source, $bind_attrs, @_);
 }
 
 sub _select {
@@ -1057,6 +1049,20 @@ sub _select {
   return $self->_execute(@args);
 }
 
+sub source_bind_attributes {
+  my ($self, $source) = @_;
+  
+  my $bind_attributes;
+  foreach my $column ($source->columns) {
+  
+    my $data_type = $source->column_info($column)->{data_type} || '';
+    $bind_attributes->{$column} = $self->bind_attribute_by_data_type($data_type)
+     if $data_type;
+  }
+
+  return $bind_attributes;
+}
+
 =head2 select
 
 =over 4
@@ -1141,18 +1147,12 @@ sub _dbh_columns_info_for {
   }
 
   my %result;
-  my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0");
+  my $sth = $dbh->prepare($self->sql_maker->select($table, undef, \'1 = 0'));
   $sth->execute;
   my @columns = @{$sth->{NAME_lc}};
   for my $i ( 0 .. $#columns ){
     my %column_info;
-    my $type_num = $sth->{TYPE}->[$i];
-    my $type_name;
-    if(defined $type_num && $dbh->can('type_info')) {
-      my $type_info = $dbh->type_info($type_num);
-      $type_name = $type_info->{TYPE_NAME} if $type_info;
-    }
-    $column_info{data_type} = $type_name ? $type_name : $type_num;
+    $column_info{data_type} = $sth->{TYPE}->[$i];
     $column_info{size} = $sth->{PRECISION}->[$i];
     $column_info{is_nullable} = $sth->{NULLABLE}->[$i] ? 1 : 0;
 
@@ -1163,6 +1163,18 @@ sub _dbh_columns_info_for {
 
     $result{$columns[$i]} = \%column_info;
   }
+  $sth->finish;
+
+  foreach my $col (keys %result) {
+    my $colinfo = $result{$col};
+    my $type_num = $colinfo->{data_type};
+    my $type_name;
+    if(defined $type_num && $dbh->can('type_info')) {
+      my $type_info = $dbh->type_info($type_num);
+      $type_name = $type_info->{TYPE_NAME} if $type_info;
+      $colinfo->{data_type} = $type_name if $type_name;
+    }
+  }
 
   return \%result;
 }
@@ -1429,7 +1441,7 @@ sub deploy {
       next if($_ =~ /^COMMIT/m);
       next if $_ =~ /^\s+$/; # skip whitespace only
       $self->debugobj->query_start($_) if $self->debug;
-      $self->dbh->do($_) or warn "SQL was:\n $_"; # XXX exceptions?
+      $self->dbh->do($_) or warn $self->dbh->errstr, "\nSQL was:\n $_"; # XXX throw_exception?
       $self->debugobj->query_end($_) if $self->debug;
     }
   }