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