Add a self-explanatory *compile-time* $ENV{DBIC_SHUFFLE_UNORDERED_RESULTSETS}
[dbsrgits/DBIx-Class.git] / t / 749sqlanywhere.t
1 use strict;
2 use warnings;
3
4 use Test::More;
5 use Test::Exception;
6 use Scope::Guard ();
7 use Try::Tiny;
8 use DBIx::Class::Optional::Dependencies ();
9 use lib qw(t/lib);
10 use DBICTest;
11
12 my ($dsn, $user, $pass)    = @ENV{map { "DBICTEST_SQLANYWHERE_${_}" }      qw/DSN USER PASS/};
13 my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_SQLANYWHERE_ODBC_${_}" } qw/DSN USER PASS/};
14
15 plan 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
26 DBICTest::Schema->load_classes('ArtistGUID');
27
28 # tests stolen from 748informix.t
29
30 plan skip_all => <<'EOF' unless $dsn || $dsn2;
31 Set $ENV{DBICTEST_SQLANYWHERE_DSN} and/or $ENV{DBICTEST_SQLANYWHERE_ODBC_DSN},
32 _USER and _PASS to run these tests
33 EOF
34
35 my @info = (
36   [ $dsn,  $user,  $pass  ],
37   [ $dsn2, $user2, $pass2 ],
38 );
39
40 my $schema;
41
42 foreach my $info (@info) {
43   my ($dsn, $user, $pass) = @$info;
44
45   next unless $dsn;
46
47   $schema = DBICTest::Schema->connect($dsn, $user, $pass, {
48     auto_savepoint => 1
49   });
50
51   my $guard = Scope::Guard->new(sub{ cleanup($schema) });
52
53   my $dbh = $schema->storage->dbh;
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   )
64 EOF
65
66   my $ars = $schema->resultset('Artist');
67   is ( $ars->count, 0, 'No rows at first' );
68
69 # test primary key handling
70   my $new = $ars->create({ name => 'foo' });
71   ok($new->artistid, "Auto-PK worked");
72
73 # test explicit key spec
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');
78
79 # test savepoints
80   throws_ok {
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     });
93   } qr/rolling back outer txn/,
94     'correct exception for rollback';
95
96   ok ((not $ars->search({ name => 'in_outer_txn' })->first),
97     'outer txn rolled back');
98
99 # test populate
100   lives_ok (sub {
101     my @pop;
102     for (1..2) {
103       push @pop, { name => "Artist_$_" };
104     }
105     $ars->populate (\@pop);
106   });
107
108 # test populate with explicit key
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   });
116
117 # count what we did so far
118   is ($ars->count, 6, 'Simple count works');
119
120 # test LIMIT support
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' );
130
131 # test iterator
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" );
136
137 # test empty insert
138   {
139     local $ars->result_source->column_info('artistid')->{is_auto_increment} = 0;
140
141     lives_ok { $ars->create({}) }
142       'empty insert works';
143   }
144
145 # test blobs (stolen from 73oracle.t)
146   eval { $dbh->do('DROP TABLE bindtype_test') };
147   $dbh->do(qq[
148   CREATE TABLE bindtype_test
149   (
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
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++;
170
171 # turn off horrendous binary DBIC_TRACE output
172       local $schema->storage->{debug} = 0;
173
174       lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) }
175       "inserted $size $type without dying";
176
177       ok($rs->find($id)->$type eq $binstr{$size}, "verified inserted $size $type" );
178     }
179   }
180
181   my @uuid_types = qw/uniqueidentifier uniqueidentifierstr/;
182
183 # test uniqueidentifiers (and the cursor_class).
184
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) = @_;
194       eval { $dbh->do("DROP TABLE artist_guid") };
195       $dbh->do(<<"SQL");
196 CREATE TABLE artist_guid (
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 )
204 SQL
205     });
206
207     local $TODO = 'something wrong with uniqueidentifierstr over ODBC'
208       if $dsn =~ /:ODBC:/ && $uuid_type eq 'uniqueidentifierstr';
209
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
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 $_ };
250
251     is try { $row_from_db->artistid }, $row->artistid,
252       'PK GUID round trip (via ->search->all)';
253
254     is try { $row_from_db->a_guid }, $row->a_guid,
255       'NON-PK GUID round trip (via ->search->all)';
256   }
257 }
258
259 done_testing;
260
261 sub cleanup {
262   my $schema = shift;
263   eval { $schema->storage->dbh->do("DROP TABLE $_") }
264     for qw/artist artist_guid bindtype_test/;
265 }