Retire useless abstraction (all rdbms need this anyway)
[dbsrgits/DBIx-Class.git] / t / 749sybase_asa.t
CommitLineData
f200d74b 1use strict;
2use warnings;
3
4use Test::More;
5use Test::Exception;
6use lib qw(t/lib);
7use DBICTest;
8
b341186f 9# tests stolen from 748informix.t
f200d74b 10
cf7b6654 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/};
f200d74b 13
8ebb1b58 14plan skip_all => <<'EOF' unless $dsn || $dsn2;
cf7b6654 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;
f200d74b 25
cf7b6654 26foreach my $info (@info) {
27 my ($dsn, $user, $pass) = @$info;
f200d74b 28
cf7b6654 29 next unless $dsn;
f200d74b 30
9cf3db6f 31 my $schema = DBICTest::Schema->connect($dsn, $user, $pass, {
32 auto_savepoint => 1
33 });
f200d74b 34
cf7b6654 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 )
ed720bc5 48EOF
f200d74b 49
cf7b6654 50 my $ars = $schema->resultset('Artist');
51 is ( $ars->count, 0, 'No rows at first' );
f200d74b 52
53# test primary key handling
cf7b6654 54 my $new = $ars->create({ name => 'foo' });
55 ok($new->artistid, "Auto-PK worked");
f200d74b 56
57# test explicit key spec
cf7b6654 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');
f200d74b 62
9cf3db6f 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
f200d74b 85# test populate
cf7b6654 86 lives_ok (sub {
87 my @pop;
88 for (1..2) {
89 push @pop, { name => "Artist_$_" };
90 }
91 $ars->populate (\@pop);
92 });
f200d74b 93
94# test populate with explicit key
cf7b6654 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 });
f200d74b 102
103# count what we did so far
cf7b6654 104 is ($ars->count, 6, 'Simple count works');
f200d74b 105
106# test LIMIT support
cf7b6654 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' );
f200d74b 116
117# test iterator
cf7b6654 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" );
f200d74b 122
ed720bc5 123# test empty insert
cf7b6654 124 {
125 local $ars->result_source->column_info('artistid')->{is_auto_increment} = 0;
ed720bc5 126
cf7b6654 127 lives_ok { $ars->create({}) }
128 'empty insert works';
129 }
ed720bc5 130
b341186f 131# test blobs (stolen from 73oracle.t)
cf7b6654 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++;
b341186f 155
ed720bc5 156# turn off horrendous binary DBIC_TRACE output
cf7b6654 157 local $schema->storage->{debug} = 0;
ed720bc5 158
cf7b6654 159 lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) }
160 "inserted $size $type without dying";
b341186f 161
cf7b6654 162 ok($rs->find($id)->$type eq $binstr{$size}, "verified inserted $size $type" );
163 }
b341186f 164 }
165}
f200d74b 166
167done_testing;
168
169# clean up our mess
170END {
cf7b6654 171 foreach my $dbh (@handles_to_clean) {
172 eval { $dbh->do("DROP TABLE $_") } for qw/artist bindtype_test/;
ed720bc5 173 }
f200d74b 174}