X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F746sybase.t;h=34ca2e1273b623b891408a31db398daec22fa04f;hb=13820f24f46862e04f71bee8ad291e4eec8ddd5f;hp=2d0132a2423ab4add98043ef0ef0ff3eb559d816;hpb=5703eb149893635ad29b0a22c72700f61a2653dd;p=dbsrgits%2FDBIx-Class-Historic.git diff --git a/t/746sybase.t b/t/746sybase.t index 2d0132a..34ca2e1 100644 --- a/t/746sybase.t +++ b/t/746sybase.t @@ -9,7 +9,7 @@ use DBICTest; my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_SYBASE_${_}" } qw/DSN USER PASS/}; -my $TESTS = 31 + 2; +my $TESTS = 35 + 2; if (not ($dsn && $user)) { plan skip_all => @@ -27,26 +27,28 @@ my @storage_types = ( my $schema; my $storage_idx = -1; +sub get_schema { + DBICTest::Schema->connect($dsn, $user, $pass, { + on_connect_call => [ + [ blob_setup => log_on_update => 1 ], # this is a safer option + ], + }); +} + for my $storage_type (@storage_types) { $storage_idx++; - $schema = DBICTest::Schema->clone; unless ($storage_type eq 'DBI::Sybase') { # autodetect - $schema->storage_type("::$storage_type"); + DBICTest::Schema->storage_type("::$storage_type"); } - $schema->connection($dsn, $user, $pass, { - AutoCommit => 1, - on_connect_call => [ - [ blob_setup => log_on_update => 1 ], # this is a safer option - ], - }); + + $schema = get_schema(); $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 +# no placeholders in this version of Sybase or DBD::Sybase (or using FreeTDS) my $tb = Test::More->builder; $tb->skip('no placeholders') for 1..$TESTS; next; @@ -54,6 +56,7 @@ for my $storage_type (@storage_types) { isa_ok( $schema->storage, "DBIx::Class::Storage::$storage_type" ); + $schema->storage->_dbh->disconnect; lives_ok (sub { $schema->storage->dbh }, 'reconnect works'); $schema->storage->dbh_do (sub { @@ -80,12 +83,27 @@ SQL $seen_id{$new->artistid}++; - for (1..6) { +# check redispatch to storage-specific insert when auto-detected storage + if ($storage_type eq 'DBI::Sybase') { + DBICTest::Schema->storage_type('::DBI'); + $schema = get_schema(); + } + + $new = $schema->resultset('Artist')->create({ name => 'Artist 1' }); + is ( $seen_id{$new->artistid}, undef, 'id for Artist 1 is unique' ); + $seen_id{$new->artistid}++; + +# inserts happen in a txn, so we make sure it still works inside a txn too + $schema->txn_begin; + + for (2..6) { $new = $schema->resultset('Artist')->create({ name => 'Artist ' . $_ }); is ( $seen_id{$new->artistid}, undef, "id for Artist $_ is unique" ); $seen_id{$new->artistid}++; } + $schema->txn_commit; + # test simple count is ($schema->resultset('Artist')->count, 7, 'count(*) of whole table ok'); @@ -130,8 +148,8 @@ SQL # 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; + skip 'TEXT/IMAGE support does not work with FreeTDS', 12 + if $schema->storage->using_freetds; my $dbh = $schema->storage->dbh; { @@ -153,9 +171,12 @@ SQL $binstr{'large'} = $binstr{'small'} x 1024; my $maxloblen = length $binstr{'large'}; - note - "Localizing LongReadLen to $maxloblen to avoid truncation of test data"; - local $dbh->{'LongReadLen'} = $maxloblen; + + if (not $schema->storage->using_freetds) { + $dbh->{'LongReadLen'} = $maxloblen * 2; + } else { + $dbh->do("set textsize ".($maxloblen * 2)); + } my $rs = $schema->resultset('BindType'); my $last_id; @@ -171,28 +192,15 @@ SQL $last_id = $created->id if $created; my $got = eval { - $rs->search({ id => $last_id }, { select => [$type] })->single->$type + $rs->find($last_id)->$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(eval { - $rs->search({ id => $last_id }, { select => ['blob'] })->single->blob - } eq $new_str, "verified updated blob" ); - diag $@ if $@; - } - # blob insert with explicit PK + # also a good opportunity to test IDENTITY_INSERT { local $SIG{__WARN__} = sub {}; eval { $dbh->do('DROP TABLE bindtype_test') }; @@ -200,7 +208,7 @@ 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 @@ -208,47 +216,78 @@ SQL ],{ RaiseError => 1, PrintError => 0 }); } my $created = eval { $rs->create( { id => 1, blob => $binstr{large} } ) }; - ok(!$@, "inserted large blob without dying"); + ok(!$@, "inserted large blob without dying with manual PK"); diag $@ if $@; my $got = eval { - $rs->search({ id => 1 }, { select => ['blob'] })->single->blob + $rs->find(1)->blob }; diag $@ if $@; - ok($got eq $binstr{large}, "verified inserted large blob"); + ok($got eq $binstr{large}, "verified inserted large blob with manual PK"); - # 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') }; + # try a blob update + my $new_str = $binstr{large} . 'mtfnpy'; - $dbh->do(qq[ - CREATE TABLE single_blob_test - ( - id INT IDENTITY PRIMARY KEY, - blob IMAGE NULL, - foo VARCHAR(256) NULL - ) - ],{ RaiseError => 1, PrintError => 0 }); + # check redispatch to storage-specific update when auto-detected storage + if ($storage_type eq 'DBI::Sybase') { + DBICTest::Schema->storage_type('::DBI'); + $schema = get_schema(); } - $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 }; + eval { $rs->search({ id => 1 })->update({ blob => $new_str }) }; + ok !$@, 'updated blob successfully'; + diag $@ if $@; + $got = eval { + $rs->find(1)->blob + }; diag $@ if $@; - ok($got eq $binstr{large}, "verified inserted large blob through ->find"); + ok($got eq $new_str, "verified updated blob"); } + +# test MONEY column support + $schema->storage->dbh_do (sub { + my ($storage, $dbh) = @_; + eval { $dbh->do("DROP TABLE money_test") }; + $dbh->do(<<'SQL'); +CREATE TABLE money_test ( + id INT IDENTITY PRIMARY KEY, + amount MONEY NULL +) +SQL + }); + + my $rs = $schema->resultset('Money'); + + my $row; + lives_ok { + $row = $rs->create({ amount => 100 }); + } 'inserted a money value'; + + is eval { $rs->find($row->id)->amount }, 100, 'money value round-trip'; + + lives_ok { + $row->update({ amount => 200 }); + } 'updated a money value'; + + is eval { $rs->find($row->id)->amount }, + 200, 'updated money value round-trip'; + + lives_ok { + $row->update({ amount => undef }); + } 'updated a money value to NULL'; + + my $null_amount = eval { $rs->find($row->id)->amount }; + ok( + (($null_amount == undef) && (not $@)), + 'updated money value to NULL round-trip' + ); + diag $@ if $@; } # clean up our mess END { if (my $dbh = eval { $schema->storage->_dbh }) { - $dbh->do('DROP TABLE artist'); - eval { $dbh->do('DROP TABLE bindtype_test') }; - eval { $dbh->do('DROP TABLE single_blob_test') }; + eval { $dbh->do("DROP TABLE $_") } + for qw/artist bindtype_test money_test/; } }