1use strict; 2use warnings; 3 4use Test::More; 5use Test::Exception; 6use lib qw(t/lib); 7use DBICTest; 8 9# tests stolen from 748informix.t 10 11my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_SYBASE_ASA_${_}" } qw/DSN USER PASS/}; 12my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_SYBASE_ASA_ODBC_${_}" } qw/DSN USER PASS/}; 13 14plan skip_all => <<'EOF' unless $dsn || $dsn2; 15Set $ENV{DBICTEST_SYBASE_ASA_DSN} and/or $ENV{DBICTEST_SYBASE_ASA_ODBC_DSN}, 16_USER and _PASS to run these tests 17EOF 18 19my @info = ( 20 [ $dsn, $user, $pass ], 21 [ $dsn2, $user2, $pass2 ], 22); 23 24my @handles_to_clean; 25 26foreach my $info (@info) { 27 my ($dsn, $user, $pass) = @$info; 28 29 next unless $dsn; 30 31 my $schema = DBICTest::Schema->connect($dsn, $user, $pass, { 32 auto_savepoint => 1 33 }); 34 35 my $dbh = $schema->storage->dbh; 36 37 push @handles_to_clean, $dbh; 38 39 eval { $dbh->do("DROP TABLE artist") }; 40 41 $dbh->do(<<EOF); 42 CREATE TABLE artist ( 43 artistid INT IDENTITY PRIMARY KEY, 44 name VARCHAR(255) NULL, 45 charfield CHAR(10) NULL, 46 rank INT DEFAULT 13 47 ) 48EOF 49 50 my $ars = $schema->resultset('Artist'); 51 is ( $ars->count, 0, 'No rows at first' ); 52 53# test primary key handling 54 my $new = $ars->create({ name => 'foo' }); 55 ok($new->artistid, "Auto-PK worked"); 56 57# test explicit key spec 58 $new = $ars->create ({ name => 'bar', artistid => 66 }); 59 is($new->artistid, 66, 'Explicit PK worked'); 60 $new->discard_changes; 61 is($new->artistid, 66, 'Explicit PK assigned'); 62 63# test savepoints 64 eval { 65 $schema->txn_do(sub { 66 eval { 67 $schema->txn_do(sub { 68 $ars->create({ name => 'in_savepoint' }); 69 die "rolling back savepoint"; 70 }); 71 }; 72 ok ((not $ars->search({ name => 'in_savepoint' })->first), 73 'savepoint rolled back'); 74 $ars->create({ name => 'in_outer_txn' }); 75 die "rolling back outer txn"; 76 }); 77 }; 78 79 like $@, qr/rolling back outer txn/, 80 'correct exception for rollback'; 81 82 ok ((not $ars->search({ name => 'in_outer_txn' })->first), 83 'outer txn rolled back'); 84 85# test populate 86 lives_ok (sub { 87 my @pop; 88 for (1..2) { 89 push @pop, { name => "Artist_$_" }; 90 } 91 $ars->populate (\@pop); 92 }); 93 94# test populate with explicit key 95 lives_ok (sub { 96 my @pop; 97 for (1..2) { 98 push @pop, { name => "Artist_expkey_$_", artistid => 100 + $_ }; 99 } 100 $ars->populate (\@pop); 101 }); 102 103# count what we did so far 104 is ($ars->count, 6, 'Simple count works'); 105 106# test LIMIT support 107 my $lim = $ars->search( {}, 108 { 109 rows => 3, 110 offset => 4, 111 order_by => 'artistid' 112 } 113 ); 114 is( $lim->count, 2, 'ROWS+OFFSET count ok' ); 115 is( $lim->all, 2, 'Number of ->all objects matches count' ); 116 117# test iterator 118 $lim->reset; 119 is( $lim->next->artistid, 101, "iterator->next ok" ); 120 is( $lim->next->artistid, 102, "iterator->next ok" ); 121 is( $lim->next, undef, "next past end of resultset ok" ); 122 123# test empty insert 124 { 125 local $ars->result_source->column_info('artistid')->{is_auto_increment} = 0; 126 127 lives_ok { $ars->create({}) } 128 'empty insert works'; 129 } 130 131# test blobs (stolen from 73oracle.t) 132 eval { $dbh->do('DROP TABLE bindtype_test') }; 133 $dbh->do(qq[ 134 CREATE TABLE bindtype_test 135 ( 136 id INT NOT NULL PRIMARY KEY, 137 bytea INT NULL, 138 blob LONG BINARY NULL, 139 clob LONG VARCHAR NULL 140 ) 141 ],{ RaiseError => 1, PrintError => 1 }); 142 143 my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) ); 144 $binstr{'large'} = $binstr{'small'} x 1024; 145 146 my $maxloblen = length $binstr{'large'}; 147 local $dbh->{'LongReadLen'} = $maxloblen; 148 149 my $rs = $schema->resultset('BindType'); 150 my $id = 0; 151 152 foreach my $type (qw( blob clob )) { 153 foreach my $size (qw( small large )) { 154 $id++; 155 156# turn off horrendous binary DBIC_TRACE output 157 local $schema->storage->{debug} = 0; 158 159 lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) } 160 "inserted $size $type without dying"; 161 162 ok($rs->find($id)->$type eq $binstr{$size}, "verified inserted $size $type" ); 163 } 164 } 165} 166 167done_testing; 168 169# clean up our mess 170END { 171 foreach my $dbh (@handles_to_clean) { 172 eval { $dbh->do("DROP TABLE $_") } for qw/artist bindtype_test/; 173 } 174} 175