[Bast-commits] r7069 - in DBIx-Class/0.08/branches/sybase:
lib/DBIx/Class/Storage/DBI t t/lib/DBICTest t/lib/DBICTest/Schema
caelum at dev.catalyst.perl.org
caelum at dev.catalyst.perl.org
Fri Jul 17 21:30:13 GMT 2009
Author: caelum
Date: 2009-07-17 21:30:13 +0000 (Fri, 17 Jul 2009)
New Revision: 7069
Added:
DBIx-Class/0.08/branches/sybase/t/lib/DBICTest/Schema/SingleBlob.pm
Modified:
DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/NoBindVars.pm
DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase.pm
DBIx-Class/0.08/branches/sybase/t/746sybase.t
DBIx-Class/0.08/branches/sybase/t/lib/DBICTest/Schema.pm
Log:
some compatibility updated for older DBD::Sybase versions, some initial work on _select_args for blobs
Modified: DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/NoBindVars.pm
===================================================================
--- DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/NoBindVars.pm 2009-07-17 09:47:31 UTC (rev 7068)
+++ DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/NoBindVars.pm 2009-07-17 21:30:13 UTC (rev 7069)
@@ -57,7 +57,7 @@
my $name_sep = $self->_sql_maker_opts->{name_sep} || '.';
$col =~ s/^([^\Q${name_sep}\E]*)\Q${name_sep}\E//;
- my $alias = $1 || 'me';
+ my $alias = $1 || $rs_alias;
my $rsrc = $alias2src->{$alias};
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 09:47:31 UTC (rev 7068)
+++ DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase.pm 2009-07-17 21:30:13 UTC (rev 7069)
@@ -31,6 +31,9 @@
But your queries will be cached.
+You need at least version C<1.09> of L<DBD::Sybase> for placeholder support.
+Otherwise your storage will be automatically reblessed into C<::NoBindVars>.
+
A recommended L<DBIx::Class::Storage::DBI/connect_info> settings:
on_connect_call => [['datetime_setup'], [blob_setup => log_on_update => 0]]
@@ -58,13 +61,30 @@
if (!$exception && $dbtype && $self->load_optional_class($subclass)) {
bless $self, $subclass;
$self->_rebless;
- } else {
- # real Sybase
+ } else { # real Sybase
+ my $no_bind_vars = 'DBIx::Class::Storage::DBI::Sybase::NoBindVars';
+
if (not $self->dbh->{syb_dynamic_supported}) {
- $self->ensure_class_loaded('DBIx::Class::Storage::DBI::Sybase::NoBindVars');
- bless $self, 'DBIx::Class::Storage::DBI::Sybase::NoBindVars';
+ $self->ensure_class_loaded($no_bind_vars);
+ bless $self, $no_bind_vars;
$self->_rebless;
}
+
+ if ($DBD::Sybase::VERSION < 1.09) {
+ carp <<'EOF';
+
+Your version of Sybase potentially supports placeholders and query caching,
+however your version of DBD::Sybase is too old to do this properly. Please
+upgrade to at least version 1.09 if you want this feature.
+
+TEXT/IMAGE column support will also not work in older versions of DBD::Sybase.
+
+See perldoc DBIx::Class::Storage::DBI::Sybase for more details.
+EOF
+ $self->ensure_class_loaded($no_bind_vars);
+ bless $self, $no_bind_vars;
+ $self->_rebless;
+ }
$self->_set_maxConnect;
}
}
@@ -116,9 +136,56 @@
sub _is_lob_type {
my $self = shift;
- shift =~ /(?:text|image|lob|bytea|binary)/i;
+ my $type = shift;
+ $type && $type =~ /(?:text|image|lob|bytea|binary)/i;
}
+# Move TEXT/IMAGE column to the end of select list, and make sure there is only
+# one.
+#
+# work in progress
+#
+# * column indexes need to be fixed if @$select is reordered, not sure if that's
+# possible
+# * needs to handle hashrefs
+# * for some reason tests pass without this, even though documentation says
+# blobs should be at the end of the select list
+# * needs to at least croak for multiple blobs
+#
+#sub _select_args {
+# my ($self, $ident, $select) = splice @_, 0, 3;
+#
+# my ($alias2src, $rs_alias) = $self->_resolve_ident_sources($ident);
+# my $name_sep = $self->_sql_maker_opts->{name_sep} || '.';
+#
+# my (@non_blobs, @blobs);
+#
+# for my $col (@$select) {
+# if (ref $col) {
+## XXX should handle hashrefs too
+# push @non_blobs, $col;
+# next;
+# }
+#
+# $col =~ s/^([^\Q${name_sep}\E]*)\Q${name_sep}\E//;
+# my $alias = $1 || $rs_alias;
+# my $rsrc = $alias2src->{$alias};
+# my $datatype = $rsrc && $rsrc->column_info($col)->{data_type};
+#
+# if ($self->_is_lob_type($datatype)) {
+# push @blobs, $col;
+# } else {
+# push @non_blobs, $col;
+# }
+# }
+#
+# croak "cannot select more than a one TEXT/IMAGE column"
+# if @blobs > 1;
+#
+# $self->next::method($ident, [@non_blobs, @blobs], @_);
+#}
+
+# override to handle TEXT/IMAGE
sub insert {
my ($self, $source, $to_insert) = splice @_, 0, 3;
@@ -305,11 +372,17 @@
=head1 IMAGE AND TEXT COLUMNS
+You need at least version C<1.09> of L<DBD::Sybase> for C<TEXT/IMAGE> column
+support.
+
See L</connect_call_blob_setup> for a L<DBIx::Class::Storage::DBI/connect_info>
setting you need to work with C<IMAGE> columns.
Due to limitations in L<DBD::Sybase> and this driver, it is only possible to
-select one C<TEXT> or C<IMAGE> column at a time.
+select one C<TEXT> or C<IMAGE> column at a time. This is handled automatically
+for tables with only one such column, if you have more than one, supply a
+C<< select => [qw/col list .../] >> key to your C<< ->search >> calls, with the
+single desired C<TEXT/IMAGE> column at the end of the list.
=head1 AUTHORS
Modified: DBIx-Class/0.08/branches/sybase/t/746sybase.t
===================================================================
--- DBIx-Class/0.08/branches/sybase/t/746sybase.t 2009-07-17 09:47:31 UTC (rev 7068)
+++ DBIx-Class/0.08/branches/sybase/t/746sybase.t 2009-07-17 21:30:13 UTC (rev 7069)
@@ -9,13 +9,15 @@
my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_SYBASE_${_}" } qw/DSN USER PASS/};
+my $TESTS = 31 + 2;
+
if (not ($dsn && $user)) {
plan skip_all =>
'Set $ENV{DBICTEST_SYBASE_DSN}, _USER and _PASS to run this test' .
"\nWarning: This test drops and creates the tables " .
"'artist' and 'bindtype_test'";
} else {
- plan tests => (29 + 2)*2;
+ plan tests => $TESTS*2;
}
my @storage_types = (
@@ -23,8 +25,10 @@
'DBI::Sybase::NoBindVars',
);
my $schema;
+my $storage_idx = -1;
for my $storage_type (@storage_types) {
+ $storage_idx++;
$schema = DBICTest::Schema->clone;
unless ($storage_type eq 'DBI::Sybase') { # autodetect
@@ -40,6 +44,14 @@
$schema->storage->ensure_connected;
$schema->storage->_dbh->disconnect;
+ if ($storage_idx == 0 &&
+ $schema->storage->isa('DBIx::Class::Storage::DBI::Sybase::NoBindVars')) {
+# no placeholders in this version of Sybase or DBD::Sybase
+ my $tb = Test::More->builder;
+ $tb->skip('no placeholders') for 1..$TESTS;
+ next;
+ }
+
isa_ok( $schema->storage, "DBIx::Class::Storage::$storage_type" );
lives_ok (sub { $schema->storage->dbh }, 'reconnect works');
@@ -116,95 +128,127 @@
is( $it->count, 7, 'COUNT of GROUP_BY ok' );
-# mostly stole the blob stuff Nniuq wrote for t/73oracle.t
- my $dbh = $schema->storage->dbh;
- {
- local $SIG{__WARN__} = sub {};
- eval { $dbh->do('DROP TABLE bindtype_test') };
+# mostly stolen from the blob stuff Nniuq wrote for t/73oracle.t
+ SKIP: {
+ skip 'Need at least version 1.09 of DBD::Sybase to test TEXT/IMAGE', 14
+ unless $DBD::Sybase::VERSION >= 1.09;
- $dbh->do(qq[
- CREATE TABLE bindtype_test
- (
- id INT IDENTITY PRIMARY KEY,
- bytea INT NULL,
- blob IMAGE NULL,
- clob TEXT NULL
- )
- ],{ RaiseError => 1, PrintError => 0 });
- }
+ my $dbh = $schema->storage->dbh;
+ {
+ local $SIG{__WARN__} = sub {};
+ eval { $dbh->do('DROP TABLE bindtype_test') };
- my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) );
- $binstr{'large'} = $binstr{'small'} x 1024;
+ $dbh->do(qq[
+ CREATE TABLE bindtype_test
+ (
+ id INT IDENTITY PRIMARY KEY,
+ bytea INT NULL,
+ blob IMAGE NULL,
+ clob TEXT NULL
+ )
+ ],{ RaiseError => 1, PrintError => 0 });
+ }
- my $maxloblen = length $binstr{'large'};
- note "Localizing LongReadLen to $maxloblen to avoid truncation of test data";
- local $dbh->{'LongReadLen'} = $maxloblen;
+ my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) );
+ $binstr{'large'} = $binstr{'small'} x 1024;
- my $rs = $schema->resultset('BindType');
- my $last_id;
+ my $maxloblen = length $binstr{'large'};
+ note
+ "Localizing LongReadLen to $maxloblen to avoid truncation of test data";
+ local $dbh->{'LongReadLen'} = $maxloblen;
- foreach my $type (qw(blob clob)) {
- foreach my $size (qw(small large)) {
- no warnings 'uninitialized';
+ my $rs = $schema->resultset('BindType');
+ my $last_id;
- my $created = eval { $rs->create( { $type => $binstr{$size} } ) };
- ok(!$@, "inserted $size $type without dying");
- diag $@ if $@;
+ foreach my $type (qw(blob clob)) {
+ foreach my $size (qw(small large)) {
+ no warnings 'uninitialized';
- $last_id = $created->id if $created;
+ my $created = eval { $rs->create( { $type => $binstr{$size} } ) };
+ ok(!$@, "inserted $size $type without dying");
+ diag $@ if $@;
- my $got = eval {
- $rs->search({ id => $last_id }, { select => [$type] })->single->$type
- };
+ $last_id = $created->id if $created;
+
+ my $got = eval {
+ $rs->search({ id => $last_id }, { select => [$type] })->single->$type
+ };
+ diag $@ if $@;
+ ok($got eq $binstr{$size}, "verified inserted $size $type");
+ }
+ }
+
+ # try a blob update
+ TODO: {
+ local $TODO = 'updating TEXT/IMAGE does not work yet';
+
+ my $new_str = $binstr{large} . 'foo';
+ eval { $rs->search({ id => $last_id })->update({ blob => $new_str }) };
+ ok !$@, 'updated blob successfully';
diag $@ if $@;
- ok($got eq $binstr{$size}, "verified inserted $size $type");
+ ok(eval {
+ $rs->search({ id => $last_id }, { select => ['blob'] })->single->blob
+ } eq $new_str, "verified updated blob" );
+ diag $@ if $@;
}
- }
- # try a blob update
- TODO: {
- local $TODO = 'updating TEXT/IMAGE does not work yet';
+ # blob insert with explicit PK
+ {
+ local $SIG{__WARN__} = sub {};
+ eval { $dbh->do('DROP TABLE bindtype_test') };
- my $new_str = $binstr{large} . 'foo';
- eval { $rs->search({ id => $last_id })->update({ blob => $new_str }) };
- ok !$@, 'updated blob successfully';
+ $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 $@;
- ok(eval {
- $rs->search({ id => $last_id }, { select => ['blob'] })->single->blob
- } eq $new_str, "verified updated blob" );
+
+ my $got = eval {
+ $rs->search({ id => 1 }, { select => ['blob'] })->single->blob
+ };
diag $@ if $@;
- }
+ ok($got eq $binstr{large}, "verified inserted large blob");
- # blob insert with explicit PK
- {
- local $SIG{__WARN__} = sub {};
- eval { $dbh->do('DROP TABLE bindtype_test') };
+ # Test select args ordering on a ->find for a table with one blob
+ {
+ local $SIG{__WARN__} = sub {};
+ eval { $dbh->do('DROP TABLE single_blob_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 });
+ $dbh->do(qq[
+ CREATE TABLE single_blob_test
+ (
+ id INT IDENTITY PRIMARY KEY,
+ blob IMAGE NULL,
+ foo VARCHAR(256) NULL
+ )
+ ],{ RaiseError => 1, PrintError => 0 });
+ }
+ $rs = $schema->resultset('SingleBlob');
+ $created = eval { $rs->create({
+ blob => $binstr{large}, foo => 'dummy'
+ }) };
+ ok(!$@, "inserted single large blob without dying");
+ diag $@ if $@;
+
+ $got = eval { $rs->find($created->id)->blob };
+ diag $@ if $@;
+ ok($got eq $binstr{large}, "verified inserted large blob through ->find");
}
- 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
END {
if (my $dbh = eval { $schema->storage->_dbh }) {
$dbh->do('DROP TABLE artist');
- $dbh->do('DROP TABLE bindtype_test');
+ eval { $dbh->do('DROP TABLE bindtype_test') };
+ eval { $dbh->do('DROP TABLE single_blob_test') };
}
}
Added: DBIx-Class/0.08/branches/sybase/t/lib/DBICTest/Schema/SingleBlob.pm
===================================================================
--- DBIx-Class/0.08/branches/sybase/t/lib/DBICTest/Schema/SingleBlob.pm (rev 0)
+++ DBIx-Class/0.08/branches/sybase/t/lib/DBICTest/Schema/SingleBlob.pm 2009-07-17 21:30:13 UTC (rev 7069)
@@ -0,0 +1,25 @@
+package # hide from PAUSE
+ DBICTest::Schema::SingleBlob;
+
+use base qw/DBICTest::BaseResult/;
+
+__PACKAGE__->table('single_blob_test');
+
+__PACKAGE__->add_columns(
+ 'id' => {
+ data_type => 'integer',
+ is_auto_increment => 1,
+ },
+ 'blob' => {
+ data_type => 'blob',
+ is_nullable => 1,
+ },
+ 'foo' => {
+ data_type => 'varchar',
+ is_nullable => 1,
+ }
+);
+
+__PACKAGE__->set_primary_key('id');
+
+1;
Modified: DBIx-Class/0.08/branches/sybase/t/lib/DBICTest/Schema.pm
===================================================================
--- DBIx-Class/0.08/branches/sybase/t/lib/DBICTest/Schema.pm 2009-07-17 09:47:31 UTC (rev 7068)
+++ DBIx-Class/0.08/branches/sybase/t/lib/DBICTest/Schema.pm 2009-07-17 21:30:13 UTC (rev 7069)
@@ -9,6 +9,7 @@
Artist
SequenceTest
BindType
+ SingleBlob
Employee
CD
FileColumn
More information about the Bast-commits
mailing list