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