[Bast-commits] r7064 - in DBIx-Class/0.08/branches/sybase:
lib/DBIx/Class/Storage/DBI lib/DBIx/Class/Storage/DBI/Sybase t
caelum at dev.catalyst.perl.org
caelum at dev.catalyst.perl.org
Fri Jul 17 07:39:55 GMT 2009
Author: caelum
Date: 2009-07-17 07:39:54 +0000 (Fri, 17 Jul 2009)
New Revision: 7064
Modified:
DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase.pm
DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm
DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase/NoBindVars.pm
DBIx-Class/0.08/branches/sybase/t/746sybase.t
Log:
make insertion of blobs into tables with identity columns work, other minor fixes
Modified: DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm
===================================================================
--- DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm 2009-07-17 01:37:28 UTC (rev 7063)
+++ DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm 2009-07-17 07:39:54 UTC (rev 7064)
@@ -10,6 +10,11 @@
/;
use mro 'c3';
+sub _rebless {
+ my $self = shift;
+ $self->disable_sth_caching(1);
+}
+
1;
=head1 NAME
Modified: DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase/NoBindVars.pm
===================================================================
--- DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase/NoBindVars.pm 2009-07-17 01:37:28 UTC (rev 7063)
+++ DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase/NoBindVars.pm 2009-07-17 07:39:54 UTC (rev 7064)
@@ -8,6 +8,11 @@
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 @@
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
Modified: DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase.pm
===================================================================
--- DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase.pm 2009-07-17 01:37:28 UTC (rev 7063)
+++ DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase.pm 2009-07-17 07:39:54 UTC (rev 7064)
@@ -79,7 +79,6 @@
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 @@
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,29 +173,41 @@
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 = $dbh->prepare_cached(
- "select $col from $table where $search_cond"
- );
- $sth->execute(map $inserted->{$_}, @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(
+ "select $col from $table where $search_cond"
+ );
+ $sth->execute;
+ }
+
eval {
while ($sth->fetch) {
$sth->func('CS_GET', 1, 'ct_data_info') or die $sth->errstr;
Modified: DBIx-Class/0.08/branches/sybase/t/746sybase.t
===================================================================
--- DBIx-Class/0.08/branches/sybase/t/746sybase.t 2009-07-17 01:37:28 UTC (rev 7063)
+++ DBIx-Class/0.08/branches/sybase/t/746sybase.t 2009-07-17 07:39:54 UTC (rev 7064)
@@ -15,7 +15,7 @@
"\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 @@
$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 @@
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 @@
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
More information about the Bast-commits
mailing list