Merge 'mssql_rno_pagination' into 'trunk'
[dbsrgits/DBIx-Class-Historic.git] / t / 746mssql.t
CommitLineData
c1cac633 1use strict;
b9a2c3a5 2use warnings;
c1cac633 3
4use Test::More;
893403c8 5use Test::Exception;
c1cac633 6use lib qw(t/lib);
7use DBICTest;
b2d16f1f 8use DBIC::SqlMakerTest;
c1cac633 9
10my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ODBC_${_}" } qw/DSN USER PASS/};
11
12plan skip_all => 'Set $ENV{DBICTEST_MSSQL_ODBC_DSN}, _USER and _PASS to run this test'
13 unless ($dsn && $user);
14
ca791b95 15DBICTest::Schema->load_classes('ArtistGUID');
42e5b103 16my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
c1cac633 17
8c0104fe 18{
19 no warnings 'redefine';
20 my $connect_count = 0;
21 my $orig_connect = \&DBI::connect;
22 local *DBI::connect = sub { $connect_count++; goto &$orig_connect };
23
24 $schema->storage->ensure_connected;
25
26 is( $connect_count, 1, 'only one connection made');
27}
9b3e916d 28
c1cac633 29isa_ok( $schema->storage, 'DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server' );
30
cf89555e 31{
32 my $schema2 = $schema->connect ($schema->storage->connect_info);
33 ok (! $schema2->storage->connected, 'a re-connected cloned schema starts unconnected');
34}
35
c5f77f6c 36$schema->storage->dbh_do (sub {
37 my ($storage, $dbh) = @_;
38 eval { $dbh->do("DROP TABLE artist") };
39 $dbh->do(<<'SQL');
c1cac633 40CREATE TABLE artist (
41 artistid INT IDENTITY NOT NULL,
a0dd8679 42 name VARCHAR(100),
39da2a2b 43 rank INT NOT NULL DEFAULT '13',
2eebd801 44 charfield CHAR(10) NULL,
c1cac633 45 primary key(artistid)
46)
c5f77f6c 47SQL
c5f77f6c 48});
49
c1cac633 50my %seen_id;
51
7b1b2582 52my @opts = (
53 { on_connect_call => 'use_dynamic_cursors' },
54 {},
55);
56my $new;
2eebd801 57
7b1b2582 58# test Auto-PK with different options
59for my $opts (@opts) {
41dd5d30 60 SKIP: {
61 $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts);
7b1b2582 62
41dd5d30 63 eval {
64 $schema->storage->ensure_connected
65 };
66 if ($@ =~ /dynamic cursors/) {
67 skip
68'Dynamic Cursors not functional, tds_version 8.0 or greater required if using'.
69' FreeTDS', 1;
70 }
7b1b2582 71
41dd5d30 72 $schema->resultset('Artist')->search({ name => 'foo' })->delete;
73
74 $new = $schema->resultset('Artist')->create({ name => 'foo' });
75
76 ok($new->artistid > 0, "Auto-PK worked");
77 }
7b1b2582 78}
c1cac633 79
80$seen_id{$new->artistid}++;
81
82# test LIMIT support
83for (1..6) {
84 $new = $schema->resultset('Artist')->create({ name => 'Artist ' . $_ });
85 is ( $seen_id{$new->artistid}, undef, "id for Artist $_ is unique" );
86 $seen_id{$new->artistid}++;
87}
88
89my $it = $schema->resultset('Artist')->search( {}, {
90 rows => 3,
91 order_by => 'artistid',
92});
93
94is( $it->count, 3, "LIMIT count ok" );
95is( $it->next->name, "foo", "iterator->next ok" );
96$it->next;
97is( $it->next->name, "Artist 2", "iterator->next ok" );
98is( $it->next, undef, "next past end of resultset ok" );
99
ca791b95 100# test GUID columns
101
102$schema->storage->dbh_do (sub {
103 my ($storage, $dbh) = @_;
104 eval { $dbh->do("DROP TABLE artist") };
105 $dbh->do(<<'SQL');
106CREATE TABLE artist (
107 artistid UNIQUEIDENTIFIER NOT NULL,
108 name VARCHAR(100),
109 rank INT NOT NULL DEFAULT '13',
110 charfield CHAR(10) NULL,
111 a_guid UNIQUEIDENTIFIER,
112 primary key(artistid)
113)
114SQL
115});
116
e34bae3a 117# start disconnected to make sure insert works on an un-reblessed storage
118$schema = DBICTest::Schema->connect($dsn, $user, $pass);
119
ca791b95 120my $row;
121lives_ok {
122 $row = $schema->resultset('ArtistGUID')->create({ name => 'mtfnpy' })
123} 'created a row with a GUID';
124
125ok(
126 eval { $row->artistid },
127 'row has GUID PK col populated',
128);
129diag $@ if $@;
130
131ok(
132 eval { $row->a_guid },
133 'row has a GUID col with auto_nextval populated',
134);
135diag $@ if $@;
136
137my $row_from_db = $schema->resultset('ArtistGUID')
138 ->search({ name => 'mtfnpy' })->first;
139
140is $row_from_db->artistid, $row->artistid,
141 'PK GUID round trip';
142
143is $row_from_db->a_guid, $row->a_guid,
144 'NON-PK GUID round trip';
145
818ec409 146# test MONEY type
147$schema->storage->dbh_do (sub {
148 my ($storage, $dbh) = @_;
149 eval { $dbh->do("DROP TABLE money_test") };
150 $dbh->do(<<'SQL');
818ec409 151CREATE TABLE money_test (
152 id INT IDENTITY PRIMARY KEY,
5064f5c3 153 amount MONEY NULL
818ec409 154)
818ec409 155SQL
818ec409 156});
157
158my $rs = $schema->resultset('Money');
159
818ec409 160lives_ok {
d68f21ee 161 $row = $rs->create({ amount => 100 });
818ec409 162} 'inserted a money value';
163
a33d2444 164cmp_ok $rs->find($row->id)->amount, '==', 100, 'money value round-trip';
818ec409 165
d68f21ee 166lives_ok {
167 $row->update({ amount => 200 });
168} 'updated a money value';
169
a33d2444 170cmp_ok $rs->find($row->id)->amount, '==', 200,
171 'updated money value round-trip';
d68f21ee 172
f6b185e1 173lives_ok {
174 $row->update({ amount => undef });
175} 'updated a money value to NULL';
176
177is $rs->find($row->id)->amount, undef,'updated money value to NULL round-trip';
178
b9a2c3a5 179$schema->storage->dbh_do (sub {
180 my ($storage, $dbh) = @_;
181 eval { $dbh->do("DROP TABLE Owners") };
182 eval { $dbh->do("DROP TABLE Books") };
183 $dbh->do(<<'SQL');
b9a2c3a5 184CREATE TABLE Books (
185 id INT IDENTITY (1, 1) NOT NULL,
186 source VARCHAR(100),
187 owner INT,
188 title VARCHAR(10),
189 price INT NULL
190)
191
192CREATE TABLE Owners (
193 id INT IDENTITY (1, 1) NOT NULL,
42e5b103 194 name VARCHAR(100),
b9a2c3a5 195)
b9a2c3a5 196SQL
197
198});
893403c8 199
200lives_ok ( sub {
e29dc2bb 201 # start a new connection, make sure rebless works
48617009 202 my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
893403c8 203 $schema->populate ('Owners', [
204 [qw/id name /],
205 [qw/1 wiggle/],
206 [qw/2 woggle/],
207 [qw/3 boggle/],
208 [qw/4 fREW/],
209 [qw/5 fRIOUX/],
210 [qw/6 fROOH/],
211 [qw/7 fRUE/],
212 [qw/8 fISMBoC/],
213 [qw/9 station/],
214 [qw/10 mirror/],
215 [qw/11 dimly/],
216 [qw/12 face_to_face/],
217 [qw/13 icarus/],
218 [qw/14 dream/],
219 [qw/15 dyrstyggyr/],
220 ]);
221}, 'populate with PKs supplied ok' );
222
afcfff01 223lives_ok (sub {
224 # start a new connection, make sure rebless works
225 # test an insert with a supplied identity, followed by one without
226 my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
227 for (1..2) {
228 my $id = $_ * 20 ;
229 $schema->resultset ('Owners')->create ({ id => $id, name => "troglodoogle $id" });
230 $schema->resultset ('Owners')->create ({ name => "troglodoogle " . ($id + 1) });
231 }
232}, 'create with/without PKs ok' );
233
234is ($schema->resultset ('Owners')->count, 19, 'owner rows really in db' );
235
893403c8 236lives_ok ( sub {
e29dc2bb 237 # start a new connection, make sure rebless works
48617009 238 my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
893403c8 239 $schema->populate ('BooksInLibrary', [
240 [qw/source owner title /],
241 [qw/Library 1 secrets0/],
242 [qw/Library 1 secrets1/],
243 [qw/Eatery 1 secrets2/],
244 [qw/Library 2 secrets3/],
245 [qw/Library 3 secrets4/],
246 [qw/Eatery 3 secrets5/],
247 [qw/Library 4 secrets6/],
248 [qw/Library 5 secrets7/],
249 [qw/Eatery 5 secrets8/],
250 [qw/Library 6 secrets9/],
251 [qw/Library 7 secrets10/],
252 [qw/Eatery 7 secrets11/],
253 [qw/Library 8 secrets12/],
254 ]);
255}, 'populate without PKs supplied ok' );
b9a2c3a5 256
f0bd60fc 257# make sure ordered subselects work
258{
259 my $book_owner_ids = $schema->resultset ('BooksInLibrary')
260 ->search ({}, { join => 'owner', distinct => 1, order_by => { -desc => 'owner'} })
261 ->get_column ('owner');
262
263 my $owners = $schema->resultset ('Owners')->search ({
264 id => { -in => $book_owner_ids->as_query }
265 });
266
267 is ($owners->count, 8, 'Correct amount of book owners');
268 is ($owners->all, 8, 'Correct amount of book owner objects');
269}
270
b9a2c3a5 271#
02d133f0 272# try a prefetch on tables with identically named columns
b9a2c3a5 273#
274
02d133f0 275# set quote char - make sure things work while quoted
276$schema->storage->_sql_maker->{quote_char} = [qw/[ ]/];
277$schema->storage->_sql_maker->{name_sep} = '.';
278
b9a2c3a5 279{
893403c8 280 # try a ->has_many direction
6bc666a5 281 my $owners = $schema->resultset ('Owners')->search (
282 {
9010bab8 283 'books.id' => { '!=', undef },
284 'me.name' => { '!=', 'somebogusstring' },
6bc666a5 285 },
286 {
fc85215b 287 prefetch => 'books',
9010bab8 288 order_by => { -asc => \['name + ?', [ test => 'xxx' ]] }, # test bindvar propagation
56d2561e 289 rows => 3, # 8 results total
6bc666a5 290 },
291 );
fc85215b 292
9010bab8 293 my ($sql, @bind) = @${$owners->page(3)->as_query};
294 is_deeply (
295 \@bind,
296 [ ([ 'me.name' => 'somebogusstring' ], [ test => 'xxx' ]) x 2 ], # double because of the prefetch subq
297 );
298
56d2561e 299 is ($owners->page(1)->all, 3, 'has_many prefetch returns correct number of rows');
300 is ($owners->page(1)->count, 3, 'has-many prefetch returns correct count');
301
6bc666a5 302 is ($owners->page(3)->all, 2, 'has_many prefetch returns correct number of rows');
303 is ($owners->page(3)->count, 2, 'has-many prefetch returns correct count');
304 is ($owners->page(3)->count_rs->next, 2, 'has-many prefetch returns correct count_rs');
305
b9a2c3a5 306
42e5b103 307 # try a ->belongs_to direction (no select collapse, group_by should work)
6bc666a5 308 my $books = $schema->resultset ('BooksInLibrary')->search (
309 {
56d2561e 310 'owner.name' => [qw/wiggle woggle/],
6bc666a5 311 },
312 {
fc85215b 313 distinct => 1,
9010bab8 314 having => \['1 = ?', [ test => 1 ] ], #test having propagation
42e5b103 315 prefetch => 'owner',
56d2561e 316 rows => 2, # 3 results total
ac93965c 317 order_by => { -desc => 'owner' },
6bc666a5 318 },
319 );
fc85215b 320
9010bab8 321 ($sql, @bind) = @${$books->page(3)->as_query};
322 is_deeply (
323 \@bind,
324 [
325 # inner
326 [ 'owner.name' => 'wiggle' ], [ 'owner.name' => 'woggle' ], [ source => 'Library' ], [ test => '1' ],
327 # outer
328 [ 'owner.name' => 'wiggle' ], [ 'owner.name' => 'woggle' ], [ source => 'Library' ],
329 ],
330 );
b1e1d073 331
56d2561e 332 is ($books->page(1)->all, 2, 'Prefetched grouped search returns correct number of rows');
333 is ($books->page(1)->count, 2, 'Prefetched grouped search returns correct count');
b1e1d073 334
6bc666a5 335 is ($books->page(2)->all, 1, 'Prefetched grouped search returns correct number of rows');
336 is ($books->page(2)->count, 1, 'Prefetched grouped search returns correct count');
337 is ($books->page(2)->count_rs->next, 1, 'Prefetched grouped search returns correct count_rs');
b9a2c3a5 338}
c1cac633 339
b8d88d9b 340# make sure right-join-side ordering limit works
341{
342 my $rs = $schema->resultset ('BooksInLibrary')->search (
343 {
344 'owner.name' => [qw/wiggle woggle/],
345 },
346 {
347 join => 'owner',
348 order_by => { -desc => 'owner.name' },
349 }
350 );
351
352 is ($rs->all, 3, 'Correct amount of objects from right-sorted joined resultset');
444b791c 353 my $limited_rs = $rs->search ({}, {rows => 3, offset => 1});
354 is ($limited_rs->count, 2, 'Correct count of limited right-sorted joined resultset');
355 is ($limited_rs->count_rs->next, 2, 'Correct count_rs of limited right-sorted joined resultset');
356 is ($limited_rs->all, 2, 'Correct amount of objects from limited right-sorted joined resultset');
357
358 is_deeply (
359 [map { $_->name } ($limited_rs->search_related ('owner')->all) ],
360 [qw/woggle wiggle/], # there is 1 woggle library book and 2 wiggle books, the limit gets us one of each
361 'Rows were properly ordered'
362 );
b8d88d9b 363}
364
afcfff01 365done_testing;
366
c1cac633 367# clean up our mess
368END {
ca791b95 369 if (my $dbh = eval { $schema->storage->_dbh }) {
370 eval { $dbh->do("DROP TABLE $_") }
371 for qw/artist money_test Books Owners/;
372 }
c1cac633 373}
fc85215b 374# vim:sw=2 sts=2