From: Rafael Kitover Date: Wed, 3 Feb 2010 04:19:59 +0000 (+0000) Subject: support for Sybase SQL Anywhere through ODBC X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cf7b66549af1fcd500a2741e5795626b0d809317;p=dbsrgits%2FDBIx-Class-Historic.git support for Sybase SQL Anywhere through ODBC --- diff --git a/lib/DBIx/Class/Storage/DBI/ODBC/SQL_Anywhere.pm b/lib/DBIx/Class/Storage/DBI/ODBC/SQL_Anywhere.pm new file mode 100644 index 0000000..15c801c --- /dev/null +++ b/lib/DBIx/Class/Storage/DBI/ODBC/SQL_Anywhere.pm @@ -0,0 +1,28 @@ +package DBIx::Class::Storage::DBI::ODBC::SQL_Anywhere; + +use strict; +use warnings; +use base qw/DBIx::Class::Storage::DBI::SQLAnywhere/; +use mro 'c3'; + +1; + +=head1 NAME + +DBIx::Class::Storage::DBI::ODBC::SQL_Anywhere - Driver for using Sybase SQL +Anywhere through ODBC + +=head1 SYNOPSIS + +All functionality is provided by L, see +that module for details. + +=head1 AUTHOR + +See L and L. + +=head1 LICENSE + +You may distribute this code under the same terms as Perl itself. + +=cut diff --git a/t/749sybase_asa.t b/t/749sybase_asa.t index 2424d3b..c4f8d6c 100644 --- a/t/749sybase_asa.t +++ b/t/749sybase_asa.t @@ -8,117 +8,135 @@ use DBICTest; # tests stolen from 748informix.t -my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_SYBASE_ASA_${_}" } qw/DSN USER PASS/}; +my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_SYBASE_ASA_${_}" } qw/DSN USER PASS/}; +my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_SYBASE_ASA_ODBC_${_}" } qw/DSN USER PASS/}; -plan skip_all => 'Set $ENV{DBICTEST_SYBASE_ASA_DSN}, _USER and _PASS to run this test' - unless ($dsn); +plan skip_all => <<"EOF" unless $dsn || $dsn2; +Set $ENV{DBICTEST_SYBASE_ASA_DSN} and/or $ENV{DBICTEST_SYBASE_ASA_ODBC_DSN}, +_USER and _PASS to run these tests +EOF + +my @info = ( + [ $dsn, $user, $pass ], + [ $dsn2, $user2, $pass2 ], +); + +my @handles_to_clean; -my $schema = DBICTest::Schema->connect($dsn, $user, $pass); +foreach my $info (@info) { + my ($dsn, $user, $pass) = @$info; -my $dbh = $schema->storage->dbh; + next unless $dsn; -eval { $dbh->do("DROP TABLE artist") }; + my $schema = DBICTest::Schema->connect($dsn, $user, $pass); -$dbh->do(<storage->dbh; + + push @handles_to_clean, $dbh; + + eval { $dbh->do("DROP TABLE artist") }; + + $dbh->do(<resultset('Artist'); -is ( $ars->count, 0, 'No rows at first' ); + my $ars = $schema->resultset('Artist'); + is ( $ars->count, 0, 'No rows at first' ); # test primary key handling -my $new = $ars->create({ name => 'foo' }); -ok($new->artistid, "Auto-PK worked"); + my $new = $ars->create({ name => 'foo' }); + ok($new->artistid, "Auto-PK worked"); # test explicit key spec -$new = $ars->create ({ name => 'bar', artistid => 66 }); -is($new->artistid, 66, 'Explicit PK worked'); -$new->discard_changes; -is($new->artistid, 66, 'Explicit PK assigned'); + $new = $ars->create ({ name => 'bar', artistid => 66 }); + is($new->artistid, 66, 'Explicit PK worked'); + $new->discard_changes; + is($new->artistid, 66, 'Explicit PK assigned'); # test populate -lives_ok (sub { - my @pop; - for (1..2) { - push @pop, { name => "Artist_$_" }; - } - $ars->populate (\@pop); -}); + lives_ok (sub { + my @pop; + for (1..2) { + push @pop, { name => "Artist_$_" }; + } + $ars->populate (\@pop); + }); # test populate with explicit key -lives_ok (sub { - my @pop; - for (1..2) { - push @pop, { name => "Artist_expkey_$_", artistid => 100 + $_ }; - } - $ars->populate (\@pop); -}); + lives_ok (sub { + my @pop; + for (1..2) { + push @pop, { name => "Artist_expkey_$_", artistid => 100 + $_ }; + } + $ars->populate (\@pop); + }); # count what we did so far -is ($ars->count, 6, 'Simple count works'); + is ($ars->count, 6, 'Simple count works'); # test LIMIT support -my $lim = $ars->search( {}, - { - rows => 3, - offset => 4, - order_by => 'artistid' - } -); -is( $lim->count, 2, 'ROWS+OFFSET count ok' ); -is( $lim->all, 2, 'Number of ->all objects matches count' ); + my $lim = $ars->search( {}, + { + rows => 3, + offset => 4, + order_by => 'artistid' + } + ); + is( $lim->count, 2, 'ROWS+OFFSET count ok' ); + is( $lim->all, 2, 'Number of ->all objects matches count' ); # test iterator -$lim->reset; -is( $lim->next->artistid, 101, "iterator->next ok" ); -is( $lim->next->artistid, 102, "iterator->next ok" ); -is( $lim->next, undef, "next past end of resultset ok" ); + $lim->reset; + is( $lim->next->artistid, 101, "iterator->next ok" ); + is( $lim->next->artistid, 102, "iterator->next ok" ); + is( $lim->next, undef, "next past end of resultset ok" ); # test empty insert -{ - local $ars->result_source->column_info('artistid')->{is_auto_increment} = 0; + { + local $ars->result_source->column_info('artistid')->{is_auto_increment} = 0; - lives_ok { $ars->create({}) } - 'empty insert works'; -} + lives_ok { $ars->create({}) } + 'empty insert works'; + } # test blobs (stolen from 73oracle.t) -eval { $dbh->do('DROP TABLE bindtype_test') }; -$dbh->do(qq[ -CREATE TABLE bindtype_test -( - id INT NOT NULL PRIMARY KEY, - bytea INT NULL, - blob LONG BINARY NULL, - clob LONG VARCHAR NULL -) -],{ RaiseError => 1, PrintError => 1 }); - -my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) ); -$binstr{'large'} = $binstr{'small'} x 1024; - -my $maxloblen = length $binstr{'large'}; -local $dbh->{'LongReadLen'} = $maxloblen; - -my $rs = $schema->resultset('BindType'); -my $id = 0; - -foreach my $type (qw( blob clob )) { - foreach my $size (qw( small large )) { - $id++; + eval { $dbh->do('DROP TABLE bindtype_test') }; + $dbh->do(qq[ + CREATE TABLE bindtype_test + ( + id INT NOT NULL PRIMARY KEY, + bytea INT NULL, + blob LONG BINARY NULL, + clob LONG VARCHAR NULL + ) + ],{ RaiseError => 1, PrintError => 1 }); + + my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) ); + $binstr{'large'} = $binstr{'small'} x 1024; + + my $maxloblen = length $binstr{'large'}; + local $dbh->{'LongReadLen'} = $maxloblen; + + my $rs = $schema->resultset('BindType'); + my $id = 0; + + foreach my $type (qw( blob clob )) { + foreach my $size (qw( small large )) { + $id++; # turn off horrendous binary DBIC_TRACE output - local $schema->storage->{debug} = 0; + local $schema->storage->{debug} = 0; - lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) } - "inserted $size $type without dying"; + lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) } + "inserted $size $type without dying"; - ok($rs->find($id)->$type eq $binstr{$size}, "verified inserted $size $type" ); + ok($rs->find($id)->$type eq $binstr{$size}, "verified inserted $size $type" ); + } } } @@ -126,7 +144,7 @@ done_testing; # clean up our mess END { - if (my $dbh = eval { $schema->storage->_dbh }) { - $dbh->do("DROP TABLE $_") for qw/artist bindtype_test/; + foreach my $dbh (@handles_to_clean) { + eval { $dbh->do("DROP TABLE $_") } for qw/artist bindtype_test/; } }