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