Move tmpdir() to DBICTest::Util where it belongs
[dbsrgits/DBIx-Class.git] / t / 747mssql_ado.t
CommitLineData
c0329273 1BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) }
cb551b07 2use DBIx::Class::Optional::Dependencies -skip_all_without => 'test_rdbms_mssql_ado';
3
4ffa5700 4use strict;
5use warnings;
6
7use Test::More;
2edf3352 8use Test::Exception;
9use Try::Tiny;
199fbc45 10use DBIx::Class::Optional::Dependencies ();
c0329273 11
4ffa5700 12use DBICTest;
13
56dca25f 14# Example DSN (from frew):
15# dbi:ADO:PROVIDER=sqlncli10;SERVER=tcp:172.24.2.10;MARS Connection=True;Initial Catalog=CIS;UID=cis_web;PWD=...;DataTypeCompatibility=80;
4ffa5700 16my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ADO_${_}" } qw/DSN USER PASS/};
17
2edf3352 18DBICTest::Schema->load_classes(qw/VaryingMAX ArtistGUID/);
19
20my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) );
21$binstr{'large'} = $binstr{'small'} x 1024;
22
23my $maxloblen = length $binstr{'large'};
24
25my $schema = DBICTest::Schema->connect($dsn, $user, $pass, {
26 auto_savepoint => 1,
27 LongReadLen => $maxloblen,
28});
29
4ffa5700 30$schema->storage->ensure_connected;
31
2edf3352 32isa_ok($schema->storage, 'DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server');
4ffa5700 33
56dca25f 34my $ver = $schema->storage->_server_info->{normalized_dbms_version};
35
36ok $ver, 'can introspect DBMS version';
37
2edf3352 38# 2005 and greater
56dca25f 39is $schema->storage->sql_limit_dialect, ($ver >= 9 ? 'RowNumberOver' : 'Top'),
40 'correct limit dialect detected';
41
4ffa5700 42$schema->storage->dbh_do (sub {
43 my ($storage, $dbh) = @_;
2edf3352 44 try { local $^W = 0; $dbh->do("DROP TABLE artist") };
4ffa5700 45 $dbh->do(<<'SQL');
46CREATE TABLE artist (
47 artistid INT IDENTITY NOT NULL,
48 name VARCHAR(100),
49 rank INT NOT NULL DEFAULT '13',
50 charfield CHAR(10) NULL,
51 primary key(artistid)
52)
53SQL
54});
55
2edf3352 56$schema->storage->dbh_do (sub {
57 my ($storage, $dbh) = @_;
58 try { local $^W = 0; $dbh->do("DROP TABLE artist_guid") };
59 $dbh->do(<<"SQL");
60CREATE TABLE artist_guid (
61 artistid UNIQUEIDENTIFIER NOT NULL,
62 name VARCHAR(100),
63 rank INT NULL,
64 charfield CHAR(10) NULL,
65 a_guid UNIQUEIDENTIFIER,
66 primary key(artistid)
67)
68SQL
69});
70
71my $have_max = $ver >= 9; # 2005 and greater
72
73$schema->storage->dbh_do (sub {
74 my ($storage, $dbh) = @_;
75 try { local $^W = 0; $dbh->do("DROP TABLE varying_max_test") };
76 $dbh->do("
77CREATE TABLE varying_max_test (
78 id INT IDENTITY NOT NULL,
79" . ($have_max ? "
80 varchar_max VARCHAR(MAX),
81 nvarchar_max NVARCHAR(MAX),
82 varbinary_max VARBINARY(MAX),
83" : "
84 varchar_max TEXT,
85 nvarchar_max NTEXT,
86 varbinary_max IMAGE,
87") . "
88 primary key(id)
89)");
90});
91
92my $ars = $schema->resultset('Artist');
93
94my $new = $ars->create({ name => 'foo' });
4ffa5700 95ok($new->artistid > 0, 'Auto-PK worked');
96
97# make sure select works
98my $found = $schema->resultset('Artist')->search({ name => 'foo' })->first;
99is $found->artistid, $new->artistid, 'search works';
100
7282bf38 101# test large column list in select
102$found = $schema->resultset('Artist')->search({ name => 'foo' }, {
56dca25f 103 select => ['artistid', 'name', map \"'foo' foo_$_", 0..50],
104 as => ['artistid', 'name', map "foo_$_", 0..50],
7282bf38 105})->first;
106is $found->artistid, $new->artistid, 'select with big column list';
107is $found->get_column('foo_50'), 'foo', 'last item in big column list';
e38348dd 108
4ffa5700 109# create a few more rows
8bcd9ece 110for (1..12) {
4ffa5700 111 $schema->resultset('Artist')->create({ name => 'Artist ' . $_ });
112}
113
114# test multiple active cursors
7c5b1b9f 115my $rs1 = $schema->resultset('Artist')->search({}, { order_by => 'artistid' });
116my $rs2 = $schema->resultset('Artist')->search({}, { order_by => 'name' });
4ffa5700 117
118while ($rs1->next) {
2edf3352 119 ok try { $rs2->next }, 'multiple active cursors';
4ffa5700 120}
121
8bcd9ece 122# test bug where ADO blows up if the first bindparam is shorter than the second
123is $schema->resultset('Artist')->search({ artistid => 2 })->first->name,
124 'Artist 1',
125 'short bindparam';
126
127is $schema->resultset('Artist')->search({ artistid => 13 })->first->name,
128 'Artist 12',
129 'longer bindparam';
130
2edf3352 131# test explicit key spec
132$new = $ars->create ({ name => 'bar', artistid => 66 });
133is($new->artistid, 66, 'Explicit PK worked');
134$new->discard_changes;
135is($new->artistid, 66, 'Explicit PK assigned');
136
137# test basic transactions
138$schema->txn_do(sub {
139 $ars->create({ name => 'transaction_commit' });
140});
141ok($ars->search({ name => 'transaction_commit' })->first,
142 'transaction committed');
143$ars->search({ name => 'transaction_commit' })->delete,
144throws_ok {
145 $schema->txn_do(sub {
146 $ars->create({ name => 'transaction_rollback' });
147 die 'rolling back';
148 });
149} qr/rolling back/, 'rollback executed';
150is $ars->search({ name => 'transaction_rollback' })->first, undef,
151 'transaction rolled back';
152
153# test two-phase commit and inner transaction rollback from nested transactions
154$schema->txn_do(sub {
155 $ars->create({ name => 'in_outer_transaction' });
156 $schema->txn_do(sub {
157 $ars->create({ name => 'in_inner_transaction' });
158 });
159 ok($ars->search({ name => 'in_inner_transaction' })->first,
160 'commit from inner transaction visible in outer transaction');
161 throws_ok {
162 $schema->txn_do(sub {
163 $ars->create({ name => 'in_inner_transaction_rolling_back' });
164 die 'rolling back inner transaction';
165 });
166 } qr/rolling back inner transaction/, 'inner transaction rollback executed';
167});
168ok($ars->search({ name => 'in_outer_transaction' })->first,
169 'commit from outer transaction');
170ok($ars->search({ name => 'in_inner_transaction' })->first,
171 'commit from inner transaction');
172is $ars->search({ name => 'in_inner_transaction_rolling_back' })->first,
173 undef,
174 'rollback from inner transaction';
175$ars->search({ name => 'in_outer_transaction' })->delete;
176$ars->search({ name => 'in_inner_transaction' })->delete;
177
178# test populate
179lives_ok (sub {
180 my @pop;
181 for (1..2) {
182 push @pop, { name => "Artist_$_" };
183 }
184 $ars->populate (\@pop);
185});
186
187# test populate with explicit key
188lives_ok (sub {
189 my @pop;
190 for (1..2) {
191 push @pop, { name => "Artist_expkey_$_", artistid => 100 + $_ };
192 }
193 $ars->populate (\@pop);
194});
195
196# count what we did so far
197is ($ars->count, 18, 'Simple count works');
198
199# test empty insert
200my $current_artistid = $ars->search({}, {
201 select => [ { max => 'artistid' } ], as => ['artistid']
202})->first->artistid;
203
204my $row;
205lives_ok { $row = $ars->create({}) }
206 'empty insert works';
207
208$row->discard_changes;
209
210is $row->artistid, $current_artistid+1,
211 'empty insert generated correct PK';
212
213# test that autoinc column still works after empty insert
214 $row = $ars->create({ name => 'after_empty_insert' });
215
216 is $row->artistid, $current_artistid+2,
217 'autoincrement column functional aftear empty insert';
218
219my $rs = $schema->resultset('VaryingMAX');
220
221foreach my $size (qw/small large/) {
49eeb48d 222 local $schema->storage->{debug} = 0 if $size eq 'large';
2edf3352 223
224 my $str = $binstr{$size};
225 my $row;
226 lives_ok {
227 $row = $rs->create({
228 varchar_max => $str, nvarchar_max => $str, varbinary_max => $str
229 });
230 } "created $size VARXXX(MAX) LOBs";
231
232 lives_ok {
233 $row->discard_changes;
234 } 're-selected just-inserted LOBs';
235
236 cmp_ok try { $row->varchar_max }, 'eq', $str, 'VARCHAR(MAX) matches';
237 cmp_ok try { $row->nvarchar_max }, 'eq', $str, 'NVARCHAR(MAX) matches';
238 cmp_ok try { $row->varbinary_max }, 'eq', $str, 'VARBINARY(MAX) matches';
2edf3352 239}
240
241# test regular blobs
242
243try { local $^W = 0; $schema->storage->dbh->do('DROP TABLE bindtype_test') };
244$schema->storage->dbh->do(qq[
245CREATE TABLE bindtype_test
246(
247 id INT IDENTITY NOT NULL PRIMARY KEY,
248 bytea INT NULL,
249 blob IMAGE NULL,
250 clob TEXT NULL,
251 a_memo NTEXT NULL
252)
253],{ RaiseError => 1, PrintError => 1 });
254
255$rs = $schema->resultset('BindType');
256my $id = 0;
257
258foreach my $type (qw( blob clob a_memo )) {
259 foreach my $size (qw( small large )) {
260 $id++;
261
262 lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) }
263 "inserted $size $type without dying" or next;
264
265 my $from_db = eval { $rs->find($id)->$type } || '';
266 diag $@ if $@;
267
268 ok($from_db eq $binstr{$size}, "verified inserted $size $type" )
269 or do {
270 my $hexdump = sub {
271 join '', map sprintf('%02X', ord), split //, shift
272 };
273 diag 'Got: ', "\n", substr($hexdump->($from_db),0,255), '...',
274 substr($hexdump->($from_db),-255);
275 diag 'Size: ', length($from_db);
276 diag 'Expected Size: ', length($binstr{$size});
277 diag 'Expected: ', "\n",
278 substr($hexdump->($binstr{$size}), 0, 255),
279 "...", substr($hexdump->($binstr{$size}),-255);
280 };
281 }
282}
283# test IMAGE update
284lives_ok {
285 $rs->search({ id => 0 })->update({ blob => $binstr{small} });
286} 'updated IMAGE to small binstr without dying';
287
288lives_ok {
289 $rs->search({ id => 0 })->update({ blob => $binstr{large} });
290} 'updated IMAGE to large binstr without dying';
291
292# test GUIDs
293lives_ok {
294 $row = $schema->resultset('ArtistGUID')->create({ name => 'mtfnpy' })
295} 'created a row with a GUID';
296
297ok(
298 eval { $row->artistid },
299 'row has GUID PK col populated',
300);
301diag $@ if $@;
302
303my $guid = try { $row->artistid }||'';
304
305ok(($guid !~ /^{.*?}\z/), 'GUID not enclosed in braces')
306 or diag "GUID is: $guid";
307
308ok(
309 eval { $row->a_guid },
310 'row has a GUID col with auto_nextval populated',
311);
312diag $@ if $@;
313
314my $row_from_db = $schema->resultset('ArtistGUID')
315 ->search({ name => 'mtfnpy' })->first;
316
317is try { $row_from_db->artistid }, try { $row->artistid },
318 'PK GUID round trip (via ->search->next)';
319
320is try { $row_from_db->a_guid }, try { $row->a_guid },
321 'NON-PK GUID round trip (via ->search->next)';
322
323$row_from_db = try { $schema->resultset('ArtistGUID')
324 ->find($row->artistid) };
325
326is try { $row_from_db->artistid }, try { $row->artistid },
327 'PK GUID round trip (via ->find)';
328
329is try { $row_from_db->a_guid }, try { $row->a_guid },
330 'NON-PK GUID round trip (via ->find)';
331
332($row_from_db) = $schema->resultset('ArtistGUID')
333 ->search({ name => 'mtfnpy' })->all;
334
335is try { $row_from_db->artistid }, try { $row->artistid },
336 'PK GUID round trip (via ->search->all)';
337
338is try { $row_from_db->a_guid }, try { $row->a_guid },
339 'NON-PK GUID round trip (via ->search->all)';
340
341lives_ok {
342 $row = $schema->resultset('ArtistGUID')->create({
343 artistid => '70171270-4822-4450-81DF-921F99BA3C06',
344 name => 'explicit_guid',
345 });
346} 'created a row with explicit PK GUID';
347
348is try { $row->artistid }, '70171270-4822-4450-81DF-921F99BA3C06',
349 'row has correct PK GUID';
350
351lives_ok {
352 $row->update({ artistid => '70171270-4822-4450-81DF-921F99BA3C07' });
353} "updated row's PK GUID";
354
355is try { $row->artistid }, '70171270-4822-4450-81DF-921F99BA3C07',
356 'row has correct PK GUID';
357
358lives_ok {
359 $row->delete;
360} 'deleted the row';
361
362lives_ok {
363 $schema->resultset('ArtistGUID')->populate([{
364 artistid => '70171270-4822-4450-81DF-921F99BA3C06',
365 name => 'explicit_guid',
366 }]);
367} 'created a row with explicit PK GUID via ->populate in void context';
368
8bcd9ece 369done_testing;
370
4ffa5700 371# clean up our mess
372END {
2edf3352 373 local $SIG{__WARN__} = sub {};
374 if (my $dbh = try { $schema->storage->_dbh }) {
375 (try { $dbh->do("DROP TABLE $_") })
376 for qw/artist artist_guid varying_max_test bindtype_test/;
4ffa5700 377 }
65d35121 378
379 undef $schema;
4ffa5700 380}
381# vim:sw=2 sts=2