make insertion of blobs into tables with identity columns work, other minor fixes

diff --git a/lib/DBIx/Class/Storage/DBI/Sybase.pm b/lib/DBIx/Class/Storage/DBI/Sybase.pm
index 5e1e5eb..cc8a0cc 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/Sybase.pm
+++ b/lib/DBIx/Class/Storage/DBI/Sybase.pm
@@ -79,7 +79,6 @@ sub _set_maxConnect {
 
   if ($dsn !~ /maxConnect=/) {
     $self->_dbi_connect_info->[0] = "$dsn;maxConnect=256";
-    # will take effect next connection
     my $connected = defined $self->_dbh;
     $self->disconnect;
     $self->ensure_connected if $connected;
@@ -159,8 +158,10 @@ sub _remove_blob_cols {
   my %blob_cols;
 
   for my $col (keys %$fields) {
-    $blob_cols{$col} = delete $fields->{$col}
-      if $self->_is_lob_type($source->column_info($col)->{data_type});
+    if ($self->_is_lob_type($source->column_info($col)->{data_type})) {
+      $blob_cols{$col} = delete $fields->{$col};
+      $fields->{$col} = \"''";
+    }
   }
 
   return \%blob_cols;
@@ -172,28 +173,40 @@ sub _update_blobs {
 
   my $table = $source->from;
 
+  my %inserted = %$inserted;
   my (@primary_cols) = $source->primary_columns;
 
-  croak "Cannot update TEXT/IMAGE without a primary key!"
+  croak "Cannot update TEXT/IMAGE column(s) without a primary key"
     unless @primary_cols;
 
-  my $search_cond = join ',' => map "$_ = ?", @primary_cols;
+  if ((grep { defined $inserted{$_} } @primary_cols) != @primary_cols) {
+    if (@primary_cols == 1) {
+      my $col = $primary_cols[0];
+      $inserted{$col} = $self->last_insert_id($source, $col);
+    } else {
+      croak "Cannot update TEXT/IMAGE column(s) without primary key values";
+    }
+  }
 
   for my $col (keys %$blob_cols) {
     my $blob = $blob_cols->{$col};
+    my $sth;
 
-# First update to empty string in case it's NULL, can't update a NULL blob using
-# the API.
-    my $sth = $dbh->prepare_cached(
-      qq{update $table set $col = '' where $search_cond}
-    );
-    $sth->execute(map $inserted->{$_}, @primary_cols) or die $sth->errstr;
-    $sth->finish;
+    if (not $self->isa('DBIx::Class::Storage::DBI::NoBindVars')) {
+      my $search_cond = join ',' => map "$_ = ?", @primary_cols;
+
+      $sth = $self->sth(
+        "select $col from $table where $search_cond"
+      );
+      $sth->execute(map $inserted{$_}, @primary_cols);
+    } else {
+      my $search_cond = join ',' => map "$_ = $inserted{$_}", @primary_cols;
 
-    $sth = $dbh->prepare_cached(
-      "select $col from $table where $search_cond"
-    );
-    $sth->execute(map $inserted->{$_}, @primary_cols);
+      $sth = $dbh->prepare(
+        "select $col from $table where $search_cond"
+      );
+      $sth->execute;
+    }
 
     eval {
       while ($sth->fetch) {

diff --git a/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm b/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm
index fd27287..9a9410f 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm
+++ b/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm
@@ -10,6 +10,11 @@ use base qw/
 /;
 use mro 'c3';
 
+sub _rebless {
+  my $self = shift;
+  $self->disable_sth_caching(1);
+}
+
 1;
 
 =head1 NAME

diff --git a/lib/DBIx/Class/Storage/DBI/Sybase/NoBindVars.pm b/lib/DBIx/Class/Storage/DBI/Sybase/NoBindVars.pm
index 8c63d8c..9d5cac7 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/Sybase/NoBindVars.pm
+++ b/lib/DBIx/Class/Storage/DBI/Sybase/NoBindVars.pm
@@ -8,6 +8,11 @@ use base qw/
 use List::Util ();
 use Scalar::Util ();
 
+sub _rebless {
+  my $self = shift;
+  $self->disable_sth_caching(1);
+}
+
 sub _dbh_last_insert_id {
   my ($self, $dbh, $source, $col) = @_;
 
@@ -39,6 +44,8 @@ sub should_quote_value {
 
   if (my $key = List::Util::first { $type =~ /$_/i } keys %noquote) {
     return 0 if $noquote{$key}->($value);
+  } elsif($self->is_datatype_numeric($type) && $number->($value)) {
+    return 0;
   }
 
 ## try to guess based on value

diff --git a/t/746sybase.t b/t/746sybase.t
index 2eeeb11..f82e3e6 100644 (file)
--- a/t/746sybase.t
+++ b/t/746sybase.t
@@ -15,7 +15,7 @@ if (not ($dsn && $user)) {
     "\nWarning: This test drops and creates the tables " .
     "'artist' and 'bindtype_test'";
 } else {
-  plan tests => (27 + 2)*2;
+  plan tests => (29 + 2)*2;
 }
 
 my @storage_types = (
@@ -125,12 +125,12 @@ SQL
     $dbh->do(qq[
       CREATE TABLE bindtype_test 
       (
-        id    INT   PRIMARY KEY,
+        id    INT   IDENTITY PRIMARY KEY,
         bytea INT   NULL,
         blob  IMAGE NULL,
         clob  TEXT  NULL
       )
-    ],{ RaiseError => 1, PrintError => 1 });
+    ],{ RaiseError => 1, PrintError => 0 });
   }
 
   my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) );
@@ -141,19 +141,20 @@ SQL
   local $dbh->{'LongReadLen'} = $maxloblen;
 
   my $rs = $schema->resultset('BindType');
-  my $id = 0;
+  my $last_id;
 
   foreach my $type (qw(blob clob)) {
     foreach my $size (qw(small large)) {
       no warnings 'uninitialized';
-      $id++;
 
-      eval { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) };
+      my $created = eval { $rs->create( { $type => $binstr{$size} } ) };
       ok(!$@, "inserted $size $type without dying");
       diag $@ if $@;
 
+      $last_id = $created->id if $created;
+
       my $got = eval {
-        $rs->search({ id=> $id }, { select => [$type] })->single->$type
+        $rs->search({ id => $last_id }, { select => [$type] })->single->$type
       };
       diag $@ if $@;
       ok($got eq $binstr{$size}, "verified inserted $size $type");
@@ -165,14 +166,39 @@ SQL
     local $TODO = 'updating TEXT/IMAGE does not work yet';
 
     my $new_str = $binstr{large} . 'foo';
-    eval { $rs->search({ id => $id })->update({ blob => $new_str }) };
+    eval { $rs->search({ id => $last_id })->update({ blob => $new_str }) };
     ok !$@, 'updated blob successfully';
     diag $@ if $@;
     ok(eval {
-      $rs->search({ id=> $id }, { select => ['blob'] })->single->blob
+      $rs->search({ id => $last_id }, { select => ['blob'] })->single->blob
     } eq $new_str, "verified updated blob" );
     diag $@ if $@;
   }
+
+  # blob insert with explicit PK
+  {
+    local $SIG{__WARN__} = sub {};
+    eval { $dbh->do('DROP TABLE bindtype_test') };
+
+    $dbh->do(qq[
+      CREATE TABLE bindtype_test 
+      (
+        id    INT   PRIMARY KEY,
+        bytea INT   NULL,
+        blob  IMAGE NULL,
+        clob  TEXT  NULL
+      )
+    ],{ RaiseError => 1, PrintError => 0 });
+  }
+  my $created = eval { $rs->create( { id => 1, blob => $binstr{large} } ) };
+  ok(!$@, "inserted large blob without dying");
+  diag $@ if $@;
+
+  my $got = eval {
+    $rs->search({ id => 1 }, { select => ['blob'] })->single->blob
+  };
+  diag $@ if $@;
+  ok($got eq $binstr{large}, "verified inserted large blob");
 }
 
 # clean up our mess