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