Part one of the sybase work by Caelum (mostly reviewed)
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI / Sybase.pm
index 6911e79..2e01e8e 100644 (file)
@@ -13,10 +13,11 @@ use List::Util ();
 use Sub::Name ();
 
 __PACKAGE__->mk_group_accessors('simple' =>
-    qw/_identity _blob_log_on_update _insert_storage _identity_method/
+    qw/_identity _blob_log_on_update _writer_storage _is_writer_storage
+       _identity_method/
 );
 
-my @delegate_to_insert_storage = qw/
+my @also_proxy_to_writer_storage = qw/
   disconnect _connect_info _sql_maker _sql_maker_opts disable_sth_caching
   auto_savepoint unsafe cursor_class debug debugobj schema
 /;
@@ -115,20 +116,27 @@ sub _init {
   # based on LongReadLen in connect_info
   $self->set_textsize if $self->using_freetds;
 
-# create storage for insert transactions
-  $self->_insert_storage((ref $self)->new);
-  $self->_insert_storage->connect_info($self->connect_info);
+# create storage for insert/(update blob) transactions,
+# unless this is that storage
+  return if $self->_is_writer_storage;
 
-  $self->_insert_storage->set_textsize if $self->using_freetds;
+  my $writer_storage = (ref $self)->new;
+
+  $writer_storage->_is_writer_storage(1);
+  $writer_storage->connect_info($self->connect_info);
+
+  $self->_writer_storage($writer_storage);
 }
 
-for my $method (@delegate_to_insert_storage) {
+for my $method (@also_proxy_to_writer_storage) {
   no strict 'refs';
 
-  *{$method} = Sub::Name::subname $method => sub {
+  my $replaced = __PACKAGE__->can($method);
+
+  *{$method} = Sub::Name::subname __PACKAGE__."::$method" => sub {
     my $self = shift;
-    $self->_insert_storage->$method(@_) if $self->_insert_storage;
-    return $self->next::method(@_);
+    $self->_writer_storage->$replaced(@_) if $self->_writer_storage;
+    return $self->$replaced(@_);
   };
 }
 
@@ -311,15 +319,15 @@ sub insert {
     );
   }
 
-  # otherwise use the _insert_storage to do the insert+transaction on another
+  # otherwise use the _writer_storage to do the insert+transaction on another
   # connection
-  my $guard = $self->_insert_storage->txn_scope_guard;
+  my $guard = $self->_writer_storage->txn_scope_guard;
 
-  my $updated_cols = $self->_insert_storage->_insert (
+  my $updated_cols = $self->_writer_storage->_insert (
     $next, $source, $to_insert, $blob_cols, $identity_col
   );
 
-  $self->_identity($self->_insert_storage->_identity);
+  $self->_identity($self->_writer_storage->_identity);
 
   $guard->commit;
 
@@ -354,7 +362,7 @@ sub update {
   }
 
 # update+blob update(s) done atomically on separate connection
-  $self = $self->_insert_storage;
+  $self = $self->_writer_storage;
 
   my $guard = $self->txn_scope_guard;
 
@@ -376,6 +384,63 @@ sub update {
   return $wantarray ? @res : $res[0];
 }
 
+### the insert_bulk stuff stolen from DBI/MSSQL.pm
+
+sub _set_identity_insert {
+  my ($self, $table) = @_;
+
+  my $sql = sprintf (
+    'SET IDENTITY_INSERT %s ON',
+    $self->sql_maker->_quote ($table),
+  );
+
+  my $dbh = $self->_get_dbh;
+  eval { $dbh->do ($sql) };
+  if ($@) {
+    $self->throw_exception (sprintf "Error executing '%s': %s",
+      $sql,
+      $dbh->errstr,
+    );
+  }
+}
+
+sub _unset_identity_insert {
+  my ($self, $table) = @_;
+
+  my $sql = sprintf (
+    'SET IDENTITY_INSERT %s OFF',
+    $self->sql_maker->_quote ($table),
+  );
+
+  my $dbh = $self->_get_dbh;
+  $dbh->do ($sql);
+}
+
+# XXX this should use the DBD::Sybase bulk API, where possible
+sub insert_bulk {
+  my $self = shift;
+  my ($source, $cols, $data) = @_;
+
+  my $is_identity_insert = (List::Util::first
+      { $source->column_info ($_)->{is_auto_increment} }
+      (@{$cols})
+  )
+     ? 1
+     : 0;
+
+  if ($is_identity_insert) {
+     $self->_set_identity_insert ($source->name);
+  }
+
+  $self->next::method(@_);
+
+  if ($is_identity_insert) {
+     $self->_unset_identity_insert ($source->name);
+  }
+}
+
+### end of stolen insert_bulk section
+
 sub _remove_blob_cols {
   my ($self, $source, $fields) = @_;
 
@@ -396,7 +461,7 @@ sub _update_blobs {
 
   my (@primary_cols) = $source->primary_columns;
 
-  croak "Cannot update TEXT/IMAGE column(s) without a primary key"
+  $self->throw_exception('Cannot update TEXT/IMAGE column(s) without a primary key')
     unless @primary_cols;
 
 # check if we're updating a single row by PK
@@ -431,12 +496,11 @@ sub _insert_blobs {
   my %row = %$row;
   my (@primary_cols) = $source->primary_columns;
 
-  croak "Cannot update TEXT/IMAGE column(s) without a primary key"
+  $self->throw_exception('Cannot update TEXT/IMAGE column(s) without a primary key')
     unless @primary_cols;
 
-  if ((grep { defined $row{$_} } @primary_cols) != @primary_cols) {
-    croak "Cannot update TEXT/IMAGE column(s) without primary key values";
-  }
+  $self->throw_exception('Cannot update TEXT/IMAGE column(s) without primary key values')
+    if ((grep { defined $row{$_} } @primary_cols) != @primary_cols);
 
   for my $col (keys %$blob_cols) {
     my $blob = $blob_cols->{$col};
@@ -470,12 +534,12 @@ sub _insert_blobs {
     $sth->finish if $sth;
     if ($exception) {
       if ($self->using_freetds) {
-        croak (
+        $self->throw_exception (
           'TEXT/IMAGE operation failed, probably because you are using FreeTDS: '
           . $exception
         );
       } else {
-        croak $exception;
+        $self->throw_exception($exception);
       }
     }
   }