'undef =>' isn't what one would want
[dbsrgits/DBIx-Class-Historic.git] / t / 74mssql.t
1 use DBIx::Class::Optional::Dependencies -skip_all_without => 'test_rdbms_mssql_sybase';
2
3 use strict;
4 use warnings;
5
6 use Test::More;
7 use Test::Exception;
8 use Scalar::Util 'weaken';
9 use lib qw(t/lib);
10 use DBICTest;
11
12 my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_${_}" } qw/DSN USER PASS/};
13 {
14   my $srv_ver = DBICTest::Schema->connect($dsn, $user, $pass)->storage->_server_info->{dbms_version};
15   ok ($srv_ver, 'Got a test server version on fresh schema: ' . ($srv_ver||'???') );
16 }
17
18 my $schema;
19
20 my $testdb_supports_placeholders = DBICTest::Schema->connect($dsn, $user, $pass)
21                                                     ->storage
22                                                      ->_supports_typeless_placeholders;
23 my @test_storages = (
24   $testdb_supports_placeholders ? 'DBI::Sybase::Microsoft_SQL_Server' : (),
25   'DBI::Sybase::Microsoft_SQL_Server::NoBindVars',
26 );
27
28 for my $storage_type (@test_storages) {
29   $schema = DBICTest::Schema->connect($dsn, $user, $pass);
30
31   if ($storage_type =~ /NoBindVars\z/) {
32     # since we want to use the nobindvar - disable the capability so the
33     # rebless happens to the correct class
34     $schema->storage->_use_typeless_placeholders (0);
35   }
36
37   local $ENV{DBIC_MSSQL_FREETDS_LOWVER_NOWARN} = 1; # disable nobindvars warning
38
39   $schema->storage->ensure_connected;
40
41   if ($storage_type =~ /NoBindVars\z/) {
42     is $schema->storage->disable_sth_caching, 1,
43       'prepare_cached disabled for NoBindVars';
44   }
45
46   isa_ok($schema->storage, "DBIx::Class::Storage::$storage_type");
47
48   SKIP: {
49     skip 'This version of DBD::Sybase segfaults on disconnect', 1 if DBD::Sybase->VERSION < 1.08;
50
51     # start disconnected to test _ping
52     $schema->storage->_dbh->disconnect;
53
54     lives_ok {
55       $schema->storage->dbh_do(sub { $_[1]->do('select 1') })
56     } '_ping works';
57   }
58
59   my $dbh = $schema->storage->dbh;
60
61   $dbh->do("IF OBJECT_ID('artist', 'U') IS NOT NULL
62       DROP TABLE artist");
63   $dbh->do("IF OBJECT_ID('cd', 'U') IS NOT NULL
64       DROP TABLE cd");
65
66   $dbh->do("CREATE TABLE artist (artistid INT IDENTITY PRIMARY KEY, name VARCHAR(100), rank INT DEFAULT '13', charfield CHAR(10) NULL);");
67   $dbh->do("CREATE TABLE cd (cdid INT IDENTITY PRIMARY KEY, artist INT,  title VARCHAR(100), year VARCHAR(100), genreid INT NULL, single_track INT NULL);");
68 # Just to test compat shim, Auto is in Core
69   $schema->class('Artist')->load_components('PK::Auto::MSSQL');
70
71 # Test PK
72   my $new = $schema->resultset('Artist')->create( { name => 'foo' } );
73   ok($new->artistid, "Auto-PK worked");
74
75 # Test LIMIT
76   for (1..6) {
77       $schema->resultset('Artist')->create( { name => 'Artist ' . $_, rank => $_ } );
78   }
79
80   my $it = $schema->resultset('Artist')->search( { },
81       { rows     => 3,
82         offset   => 2,
83         order_by => 'artistid'
84       }
85   );
86
87 # Test ? in data don't get treated as placeholders
88   my $cd = $schema->resultset('CD')->create( {
89       artist      => 1,
90       title       => 'Does this break things?',
91       year        => 2007,
92   } );
93   ok($cd->id, 'Not treating ? in data as placeholders');
94
95   is( $it->count, 3, "LIMIT count ok" );
96   ok( $it->next->name, "iterator->next ok" );
97   $it->next;
98   $it->next;
99   is( $it->next, undef, "next past end of resultset ok" );
100
101 # test MONEY column support
102   $schema->storage->dbh_do (sub {
103       my ($storage, $dbh) = @_;
104       eval { $dbh->do("DROP TABLE money_test") };
105       $dbh->do(<<'SQL');
106   CREATE TABLE money_test (
107      id INT IDENTITY PRIMARY KEY,
108      amount MONEY NULL
109   )
110 SQL
111    });
112
113   my $rs = $schema->resultset('Money');
114   weaken(my $rs_cp = $rs);  # nested closure refcounting is an utter mess in perl
115
116   my $row;
117   lives_ok {
118     $row = $rs->create({ amount => 100 });
119   } 'inserted a money value';
120
121   cmp_ok $rs->find($row->id)->amount, '==', 100, 'money value round-trip';
122
123   lives_ok {
124     $row->update({ amount => 200 });
125   } 'updated a money value';
126
127   cmp_ok $rs->find($row->id)->amount, '==', 200,
128     'updated money value round-trip';
129
130   lives_ok {
131     $row->update({ amount => undef });
132   } 'updated a money value to NULL';
133
134   is $rs->find($row->id)->amount,
135     undef, 'updated money value to NULL round-trip';
136
137   $rs->delete;
138
139   # test simple transaction with commit
140   lives_ok {
141     $schema->txn_do(sub {
142       $rs_cp->create({ amount => 300 });
143     });
144   } 'simple transaction';
145
146   cmp_ok $rs->first->amount, '==', 300, 'committed';
147
148   $rs->reset;
149   $rs->delete;
150
151   # test rollback
152   throws_ok {
153     $schema->txn_do(sub {
154       $rs_cp->create({ amount => 700 });
155       die 'mtfnpy';
156     });
157   } qr/mtfnpy/, 'simple failed txn';
158
159   is $rs->first, undef, 'rolled back';
160
161   $rs->reset;
162   $rs->delete;
163
164   # test multiple active statements
165   {
166     $rs->create({ amount => 800 + $_ }) for 1..3;
167
168     my @map = (
169       [ 'Artist 1', '801.00' ],
170       [ 'Artist 2', '802.00' ],
171       [ 'Artist 3', '803.00' ]
172     );
173
174     my $artist_rs = $schema->resultset('Artist')->search({
175       name => { -like => 'Artist %' }
176     });;
177
178     my $i = 0;
179
180     while (my $money_row = $rs->next) {
181       my $artist_row = $artist_rs->next;
182
183       is_deeply [ $artist_row->name, $money_row->amount ], $map[$i++],
184         'multiple active statements';
185     }
186     $rs->reset;
187     $rs->delete;
188   }
189
190   my $wrappers = {
191     no_transaction => sub { shift->() },
192     txn_do => sub { my $code = shift; $schema->txn_do(sub { $code->() } ) },
193     txn_begin => sub { $schema->txn_begin; shift->(); $schema->txn_commit },
194     txn_guard => sub { my $g = $schema->txn_scope_guard; shift->(); $g->commit },
195   };
196
197   # test transaction handling on a disconnected handle
198   for my $wrapper (keys %$wrappers) {
199     $rs->delete;
200
201     # a reconnect should trigger on next action
202     $schema->storage->_get_dbh->disconnect;
203
204
205     lives_and {
206       $wrappers->{$wrapper}->( sub {
207         $rs_cp->create({ amount => 900 + $_ }) for 1..3;
208       });
209       is $rs->count, 3;
210     } "transaction on disconnected handle with $wrapper wrapper";
211   }
212
213   # test transaction handling on a disconnected handle with multiple active
214   # statements
215   for my $wrapper (keys %$wrappers) {
216     $schema->storage->disconnect;
217     $rs->delete;
218     $rs->reset;
219     $rs->create({ amount => 1000 + $_ }) for (1..3);
220
221     my $artist_rs = $schema->resultset('Artist')->search({
222       name => { -like => 'Artist %' }
223     });;
224
225     $rs->next;
226
227     my $map = [ ['Artist 1', '1002.00'], ['Artist 2', '1003.00'] ];
228
229     weaken(my $a_rs_cp = $artist_rs);
230
231     local $TODO = 'Transaction handling with multiple active statements will '
232                  .'need eager cursor support.'
233       unless $wrapper eq 'no_transaction';
234
235     lives_and {
236       my @results;
237
238       $wrappers->{$wrapper}->( sub {
239         while (my $money = $rs_cp->next) {
240           my $artist = $a_rs_cp->next;
241           push @results, [ $artist->name, $money->amount ];
242         };
243       });
244
245       is_deeply \@results, $map;
246     } "transactions with multiple active statement with $wrapper wrapper";
247   }
248
249   # test RNO detection when version detection fails
250   SKIP: {
251     my $storage = $schema->storage;
252     my $version = $storage->_server_info->{normalized_dbms_version};
253
254     skip 'could not detect SQL Server version', 1 if not defined $version;
255
256     my $have_rno = $version >= 9 ? 1 : 0;
257
258     local $storage->{_dbh_details}{info} = {}; # delete cache
259
260     my $rno_detected =
261       ($storage->sql_limit_dialect eq 'RowNumberOver') ? 1 : 0;
262
263     ok (($have_rno == $rno_detected),
264       'row_number() over support detected correctly');
265   }
266
267   {
268     my $schema = DBICTest::Schema->clone;
269     $schema->connection($dsn, $user, $pass);
270
271     like $schema->storage->sql_maker->{limit_dialect},
272       qr/^(?:Top|RowNumberOver)\z/,
273       'sql_maker is correct on unconnected schema';
274   }
275 }
276
277 # test op-induced autoconnect
278 lives_ok (sub {
279
280   my $schema =  DBICTest::Schema->clone;
281   $schema->connection($dsn, $user, $pass);
282
283   my $artist = $schema->resultset ('Artist')->search ({}, { order_by => 'artistid' })->next;
284   is ($artist->id, 1, 'Artist retrieved successfully');
285 }, 'Query-induced autoconnect works');
286
287 # test AutoCommit=0
288 {
289   local $ENV{DBIC_UNSAFE_AUTOCOMMIT_OK} = 1;
290   my $schema2 = DBICTest::Schema->connect($dsn, $user, $pass, { AutoCommit => 0 });
291
292   my $rs = $schema2->resultset('Money');
293
294   $rs->delete;
295   $schema2->txn_commit;
296
297   is $rs->count, 0, 'initially empty'
298     || diag ('Found row with amount ' . $_->amount) for $rs->all;
299
300   $rs->create({ amount => 3000 });
301   $schema2->txn_rollback;
302
303   is $rs->count, 0, 'rolled back in AutoCommit=0'
304     || diag ('Found row with amount ' . $_->amount) for $rs->all;
305
306   $rs->create({ amount => 4000 });
307   $schema2->txn_commit;
308
309   cmp_ok $rs->first->amount, '==', 4000, 'committed in AutoCommit=0';
310 }
311
312 done_testing;
313
314 # clean up our mess
315 END {
316   if (my $dbh = eval { $schema->storage->dbh }) {
317     $dbh->do("IF OBJECT_ID('artist', 'U') IS NOT NULL DROP TABLE artist");
318     $dbh->do("IF OBJECT_ID('cd', 'U') IS NOT NULL DROP TABLE cd");
319     $dbh->do("IF OBJECT_ID('money_test', 'U') IS NOT NULL DROP TABLE money_test");
320   }
321
322   undef $schema;
323 }