'undef =>' isn't what one would want
[dbsrgits/DBIx-Class-Historic.git] / t / 74mssql.t
CommitLineData
cb551b07 1use DBIx::Class::Optional::Dependencies -skip_all_without => 'test_rdbms_mssql_sybase';
2
70350518 3use strict;
bbdda281 4use warnings;
70350518 5
6use Test::More;
8c52ffd3 7use Test::Exception;
65d35121 8use Scalar::Util 'weaken';
70350518 9use lib qw(t/lib);
10use DBICTest;
eef2ff6c 11
12my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_${_}" } qw/DSN USER PASS/};
77c7628c 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
b30f1a32 18my $schema;
19
bbdda281 20my $testdb_supports_placeholders = DBICTest::Schema->connect($dsn, $user, $pass)
21 ->storage
22 ->_supports_typeless_placeholders;
23my @test_storages = (
24 $testdb_supports_placeholders ? 'DBI::Sybase::Microsoft_SQL_Server' : (),
c29ce317 25 'DBI::Sybase::Microsoft_SQL_Server::NoBindVars',
7379eb67 26);
8c52ffd3 27
bbdda281 28for my $storage_type (@test_storages) {
29 $schema = DBICTest::Schema->connect($dsn, $user, $pass);
eef2ff6c 30
bbdda281 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);
7379eb67 35 }
36
c1e5a9ac 37 local $ENV{DBIC_MSSQL_FREETDS_LOWVER_NOWARN} = 1; # disable nobindvars warning
38
bbdda281 39 $schema->storage->ensure_connected;
b30f1a32 40
41 if ($storage_type =~ /NoBindVars\z/) {
42 is $schema->storage->disable_sth_caching, 1,
43 'prepare_cached disabled for NoBindVars';
44 }
45
c29ce317 46 isa_ok($schema->storage, "DBIx::Class::Storage::$storage_type");
7379eb67 47
99083752 48 SKIP: {
49 skip 'This version of DBD::Sybase segfaults on disconnect', 1 if DBD::Sybase->VERSION < 1.08;
7379eb67 50
99083752 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 }
ecdf1ac8 58
59 my $dbh = $schema->storage->dbh;
7379eb67 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);");
3ff5b740 68# Just to test compat shim, Auto is in Core
7379eb67 69 $schema->class('Artist')->load_components('PK::Auto::MSSQL');
eef2ff6c 70
71# Test PK
7379eb67 72 my $new = $schema->resultset('Artist')->create( { name => 'foo' } );
73 ok($new->artistid, "Auto-PK worked");
eef2ff6c 74
75# Test LIMIT
7379eb67 76 for (1..6) {
77 $schema->resultset('Artist')->create( { name => 'Artist ' . $_, rank => $_ } );
78 }
eef2ff6c 79
7379eb67 80 my $it = $schema->resultset('Artist')->search( { },
81 { rows => 3,
82 offset => 2,
83 order_by => 'artistid'
84 }
85 );
eef2ff6c 86
b4474f31 87# Test ? in data don't get treated as placeholders
7379eb67 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" );
eef2ff6c 100
5064f5c3 101# test MONEY column support
7379eb67 102 $schema->storage->dbh_do (sub {
103 my ($storage, $dbh) = @_;
104 eval { $dbh->do("DROP TABLE money_test") };
105 $dbh->do(<<'SQL');
7379eb67 106 CREATE TABLE money_test (
107 id INT IDENTITY PRIMARY KEY,
108 amount MONEY NULL
109 )
5064f5c3 110SQL
b30f1a32 111 });
5064f5c3 112
65d35121 113 my $rs = $schema->resultset('Money');
114 weaken(my $rs_cp = $rs); # nested closure refcounting is an utter mess in perl
5064f5c3 115
7379eb67 116 my $row;
117 lives_ok {
118 $row = $rs->create({ amount => 100 });
119 } 'inserted a money value';
5064f5c3 120
a33d2444 121 cmp_ok $rs->find($row->id)->amount, '==', 100, 'money value round-trip';
5064f5c3 122
7379eb67 123 lives_ok {
124 $row->update({ amount => 200 });
125 } 'updated a money value';
5064f5c3 126
a33d2444 127 cmp_ok $rs->find($row->id)->amount, '==', 200,
128 'updated money value round-trip';
5064f5c3 129
7379eb67 130 lives_ok {
131 $row->update({ amount => undef });
132 } 'updated a money value to NULL';
5064f5c3 133
c8365716 134 is $rs->find($row->id)->amount,
135 undef, 'updated money value to NULL round-trip';
a467a0c9 136
b90d7eba 137 $rs->delete;
138
139 # test simple transaction with commit
140 lives_ok {
141 $schema->txn_do(sub {
65d35121 142 $rs_cp->create({ amount => 300 });
b90d7eba 143 });
144 } 'simple transaction';
145
b30f1a32 146 cmp_ok $rs->first->amount, '==', 300, 'committed';
b90d7eba 147
b30f1a32 148 $rs->reset;
b90d7eba 149 $rs->delete;
150
151 # test rollback
152 throws_ok {
153 $schema->txn_do(sub {
65d35121 154 $rs_cp->create({ amount => 700 });
b90d7eba 155 die 'mtfnpy';
156 });
157 } qr/mtfnpy/, 'simple failed txn';
158
159 is $rs->first, undef, 'rolled back';
b30f1a32 160
b90d7eba 161 $rs->reset;
b30f1a32 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
c1e5a9ac 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 };
7fc9679d 196
197 # test transaction handling on a disconnected handle
c1e5a9ac 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
65d35121 204
c1e5a9ac 205 lives_and {
206 $wrappers->{$wrapper}->( sub {
65d35121 207 $rs_cp->create({ amount => 900 + $_ }) for 1..3;
c1e5a9ac 208 });
209 is $rs->count, 3;
210 } "transaction on disconnected handle with $wrapper wrapper";
211 }
212
7fc9679d 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
c1e5a9ac 231 local $TODO = 'Transaction handling with multiple active statements will '
7fc9679d 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";
c1e5a9ac 247 }
a218ef4e 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};
99083752 253
254 skip 'could not detect SQL Server version', 1 if not defined $version;
a218ef4e 255
256 my $have_rno = $version >= 9 ? 1 : 0;
257
bbdda281 258 local $storage->{_dbh_details}{info} = {}; # delete cache
4282b6f8 259
a218ef4e 260 my $rno_detected =
6a247f33 261 ($storage->sql_limit_dialect eq 'RowNumberOver') ? 1 : 0;
a218ef4e 262
233c3a46 263 ok (($have_rno == $rno_detected),
a218ef4e 264 'row_number() over support detected correctly');
265 }
0a064375 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 }
7379eb67 275}
5064f5c3 276
559ae74c 277# test op-induced autoconnect
278lives_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
c1e5a9ac 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
1a789a72 312done_testing;
313
3ff5b740 314# clean up our mess
315END {
7379eb67 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 }
65d35121 321
322 undef $schema;
3ff5b740 323}