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