Fixup SQLA monkeypatch in anticipation of new SQLA version
[dbsrgits/DBIx-Class.git] / t / 749sqlanywhere.t
CommitLineData
f200d74b 1use strict;
2use warnings;
3
4use Test::More;
5use Test::Exception;
548d1627 6use Scope::Guard ();
4b3515a6 7use Try::Tiny;
f200d74b 8use lib qw(t/lib);
9use DBICTest;
10
548d1627 11DBICTest::Schema->load_classes('ArtistGUID');
12
b341186f 13# tests stolen from 748informix.t
f200d74b 14
374f18f2 15my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_SQLANYWHERE_${_}" } qw/DSN USER PASS/};
16my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_SQLANYWHERE_ODBC_${_}" } qw/DSN USER PASS/};
f200d74b 17
8ebb1b58 18plan skip_all => <<'EOF' unless $dsn || $dsn2;
374f18f2 19Set $ENV{DBICTEST_SQLANYWHERE_DSN} and/or $ENV{DBICTEST_SQLANYWHERE_ODBC_DSN},
cf7b6654 20_USER and _PASS to run these tests
21EOF
22
23my @info = (
24 [ $dsn, $user, $pass ],
25 [ $dsn2, $user2, $pass2 ],
26);
27
548d1627 28my $schema;
f200d74b 29
cf7b6654 30foreach my $info (@info) {
31 my ($dsn, $user, $pass) = @$info;
f200d74b 32
cf7b6654 33 next unless $dsn;
f200d74b 34
548d1627 35 $schema = DBICTest::Schema->connect($dsn, $user, $pass, {
9cf3db6f 36 auto_savepoint => 1
37 });
f200d74b 38
548d1627 39 my $guard = Scope::Guard->new(\&cleanup);
cf7b6654 40
548d1627 41 my $dbh = $schema->storage->dbh;
cf7b6654 42
43 eval { $dbh->do("DROP TABLE artist") };
44
45 $dbh->do(<<EOF);
46 CREATE TABLE artist (
47 artistid INT IDENTITY PRIMARY KEY,
48 name VARCHAR(255) NULL,
49 charfield CHAR(10) NULL,
50 rank INT DEFAULT 13
51 )
ed720bc5 52EOF
f200d74b 53
cf7b6654 54 my $ars = $schema->resultset('Artist');
55 is ( $ars->count, 0, 'No rows at first' );
f200d74b 56
57# test primary key handling
cf7b6654 58 my $new = $ars->create({ name => 'foo' });
59 ok($new->artistid, "Auto-PK worked");
f200d74b 60
61# test explicit key spec
cf7b6654 62 $new = $ars->create ({ name => 'bar', artistid => 66 });
63 is($new->artistid, 66, 'Explicit PK worked');
64 $new->discard_changes;
65 is($new->artistid, 66, 'Explicit PK assigned');
f200d74b 66
9cf3db6f 67# test savepoints
b9889595 68 throws_ok {
9cf3db6f 69 $schema->txn_do(sub {
70 eval {
71 $schema->txn_do(sub {
72 $ars->create({ name => 'in_savepoint' });
73 die "rolling back savepoint";
74 });
75 };
76 ok ((not $ars->search({ name => 'in_savepoint' })->first),
77 'savepoint rolled back');
78 $ars->create({ name => 'in_outer_txn' });
79 die "rolling back outer txn";
80 });
b9889595 81 } qr/rolling back outer txn/,
9cf3db6f 82 'correct exception for rollback';
83
84 ok ((not $ars->search({ name => 'in_outer_txn' })->first),
85 'outer txn rolled back');
86
f200d74b 87# test populate
cf7b6654 88 lives_ok (sub {
89 my @pop;
90 for (1..2) {
91 push @pop, { name => "Artist_$_" };
92 }
93 $ars->populate (\@pop);
94 });
f200d74b 95
96# test populate with explicit key
cf7b6654 97 lives_ok (sub {
98 my @pop;
99 for (1..2) {
100 push @pop, { name => "Artist_expkey_$_", artistid => 100 + $_ };
101 }
102 $ars->populate (\@pop);
103 });
f200d74b 104
105# count what we did so far
cf7b6654 106 is ($ars->count, 6, 'Simple count works');
f200d74b 107
108# test LIMIT support
cf7b6654 109 my $lim = $ars->search( {},
110 {
111 rows => 3,
112 offset => 4,
113 order_by => 'artistid'
114 }
115 );
116 is( $lim->count, 2, 'ROWS+OFFSET count ok' );
117 is( $lim->all, 2, 'Number of ->all objects matches count' );
f200d74b 118
119# test iterator
cf7b6654 120 $lim->reset;
121 is( $lim->next->artistid, 101, "iterator->next ok" );
122 is( $lim->next->artistid, 102, "iterator->next ok" );
123 is( $lim->next, undef, "next past end of resultset ok" );
f200d74b 124
ed720bc5 125# test empty insert
cf7b6654 126 {
127 local $ars->result_source->column_info('artistid')->{is_auto_increment} = 0;
ed720bc5 128
cf7b6654 129 lives_ok { $ars->create({}) }
130 'empty insert works';
131 }
ed720bc5 132
b341186f 133# test blobs (stolen from 73oracle.t)
cf7b6654 134 eval { $dbh->do('DROP TABLE bindtype_test') };
135 $dbh->do(qq[
136 CREATE TABLE bindtype_test
137 (
f3a9ea3d 138 id INT NOT NULL PRIMARY KEY,
139 bytea INT NULL,
140 blob LONG BINARY NULL,
141 clob LONG VARCHAR NULL,
142 a_memo INT NULL
cf7b6654 143 )
144 ],{ RaiseError => 1, PrintError => 1 });
145
146 my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) );
147 $binstr{'large'} = $binstr{'small'} x 1024;
148
149 my $maxloblen = length $binstr{'large'};
150 local $dbh->{'LongReadLen'} = $maxloblen;
151
152 my $rs = $schema->resultset('BindType');
153 my $id = 0;
154
155 foreach my $type (qw( blob clob )) {
156 foreach my $size (qw( small large )) {
157 $id++;
b341186f 158
ed720bc5 159# turn off horrendous binary DBIC_TRACE output
cf7b6654 160 local $schema->storage->{debug} = 0;
ed720bc5 161
cf7b6654 162 lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) }
163 "inserted $size $type without dying";
b341186f 164
cf7b6654 165 ok($rs->find($id)->$type eq $binstr{$size}, "verified inserted $size $type" );
166 }
b341186f 167 }
548d1627 168
169 my @uuid_types = qw/uniqueidentifier uniqueidentifierstr/;
170
4b3515a6 171# test uniqueidentifiers (and the cursor_class).
172
548d1627 173 for my $uuid_type (@uuid_types) {
174 local $schema->source('ArtistGUID')->column_info('artistid')->{data_type}
175 = $uuid_type;
176
177 local $schema->source('ArtistGUID')->column_info('a_guid')->{data_type}
178 = $uuid_type;
179
180 $schema->storage->dbh_do (sub {
181 my ($storage, $dbh) = @_;
b1bdb76d 182 eval { $dbh->do("DROP TABLE artist_guid") };
548d1627 183 $dbh->do(<<"SQL");
b1bdb76d 184CREATE TABLE artist_guid (
548d1627 185 artistid $uuid_type NOT NULL,
186 name VARCHAR(100),
187 rank INT NOT NULL DEFAULT '13',
188 charfield CHAR(10) NULL,
189 a_guid $uuid_type,
190 primary key(artistid)
191)
192SQL
193 });
194
4b3515a6 195 local $TODO = 'something wrong with uniqueidentifierstr over ODBC'
196 if $dsn =~ /:ODBC:/ && $uuid_type eq 'uniqueidentifierstr';
197
548d1627 198 my $row;
199 lives_ok {
200 $row = $schema->resultset('ArtistGUID')->create({ name => 'mtfnpy' })
201 } 'created a row with a GUID';
202
203 ok(
204 eval { $row->artistid },
205 'row has GUID PK col populated',
206 );
207 diag $@ if $@;
208
209 ok(
210 eval { $row->a_guid },
211 'row has a GUID col with auto_nextval populated',
212 );
213 diag $@ if $@;
214
4b3515a6 215 my $row_from_db = try { $schema->resultset('ArtistGUID')
216 ->search({ name => 'mtfnpy' })->first }
217 catch { diag $_ };
218
219 is try { $row_from_db->artistid }, $row->artistid,
220 'PK GUID round trip (via ->search->next)';
221
222 is try { $row_from_db->a_guid }, $row->a_guid,
223 'NON-PK GUID round trip (via ->search->next)';
224
225 $row_from_db = try { $schema->resultset('ArtistGUID')
226 ->find($row->artistid) }
227 catch { diag $_ };
228
229 is try { $row_from_db->artistid }, $row->artistid,
230 'PK GUID round trip (via ->find)';
231
232 is try { $row_from_db->a_guid }, $row->a_guid,
233 'NON-PK GUID round trip (via ->find)';
234
235 ($row_from_db) = try { $schema->resultset('ArtistGUID')
236 ->search({ name => 'mtfnpy' })->all }
237 catch { diag $_ };
548d1627 238
4b3515a6 239 is try { $row_from_db->artistid }, $row->artistid,
240 'PK GUID round trip (via ->search->all)';
548d1627 241
4b3515a6 242 is try { $row_from_db->a_guid }, $row->a_guid,
243 'NON-PK GUID round trip (via ->search->all)';
548d1627 244 }
b341186f 245}
f200d74b 246
247done_testing;
248
548d1627 249sub cleanup {
b1bdb76d 250 eval { $schema->storage->dbh->do("DROP TABLE $_") }
251 for qw/artist artist_guid bindtype_test/;
f200d74b 252}