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