8 use DBIC::SqlMakerTest;
10 my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ODBC_${_}" } qw/DSN USER PASS/};
12 plan skip_all => 'Set $ENV{DBICTEST_MSSQL_ODBC_DSN}, _USER and _PASS to run this test'
13 unless ($dsn && $user);
15 DBICTest::Schema->load_classes('ArtistGUID');
16 my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
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 };
24 $schema->storage->ensure_connected;
26 is( $connect_count, 1, 'only one connection made');
29 isa_ok( $schema->storage, 'DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server' );
32 my $schema2 = $schema->connect ($schema->storage->connect_info);
33 ok (! $schema2->storage->connected, 'a re-connected cloned schema starts unconnected');
36 $schema->storage->dbh_do (sub {
37 my ($storage, $dbh) = @_;
38 eval { $dbh->do("DROP TABLE artist") };
41 artistid INT IDENTITY NOT NULL,
43 rank INT NOT NULL DEFAULT '13',
44 charfield CHAR(10) NULL,
53 { on_connect_call => 'use_dynamic_cursors' },
58 # test Auto-PK with different options
59 for my $opts (@opts) {
61 $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts);
64 $schema->storage->ensure_connected
66 if ($@ =~ /dynamic cursors/) {
68 'Dynamic Cursors not functional, tds_version 8.0 or greater required if using'.
72 $schema->resultset('Artist')->search({ name => 'foo' })->delete;
74 $new = $schema->resultset('Artist')->create({ name => 'foo' });
76 ok($new->artistid > 0, "Auto-PK worked");
80 $seen_id{$new->artistid}++;
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}++;
89 my $it = $schema->resultset('Artist')->search( {}, {
91 order_by => 'artistid',
94 is( $it->count, 3, "LIMIT count ok" );
95 is( $it->next->name, "foo", "iterator->next ok" );
97 is( $it->next->name, "Artist 2", "iterator->next ok" );
98 is( $it->next, undef, "next past end of resultset ok" );
102 $schema->storage->dbh_do (sub {
103 my ($storage, $dbh) = @_;
104 eval { $dbh->do("DROP TABLE artist") };
106 CREATE TABLE artist (
107 artistid UNIQUEIDENTIFIER NOT NULL,
109 rank INT NOT NULL DEFAULT '13',
110 charfield CHAR(10) NULL,
111 a_guid UNIQUEIDENTIFIER,
112 primary key(artistid)
117 # start disconnected to make sure insert works on an un-reblessed storage
118 $schema = DBICTest::Schema->connect($dsn, $user, $pass);
122 $row = $schema->resultset('ArtistGUID')->create({ name => 'mtfnpy' })
123 } 'created a row with a GUID';
126 eval { $row->artistid },
127 'row has GUID PK col populated',
132 eval { $row->a_guid },
133 'row has a GUID col with auto_nextval populated',
137 my $row_from_db = $schema->resultset('ArtistGUID')
138 ->search({ name => 'mtfnpy' })->first;
140 is $row_from_db->artistid, $row->artistid,
141 'PK GUID round trip';
143 is $row_from_db->a_guid, $row->a_guid,
144 'NON-PK GUID round trip';
147 $schema->storage->dbh_do (sub {
148 my ($storage, $dbh) = @_;
149 eval { $dbh->do("DROP TABLE money_test") };
151 CREATE TABLE money_test (
152 id INT IDENTITY PRIMARY KEY,
158 my $rs = $schema->resultset('Money');
161 $row = $rs->create({ amount => 100 });
162 } 'inserted a money value';
164 cmp_ok $rs->find($row->id)->amount, '==', 100, 'money value round-trip';
167 $row->update({ amount => 200 });
168 } 'updated a money value';
170 cmp_ok $rs->find($row->id)->amount, '==', 200,
171 'updated money value round-trip';
174 $row->update({ amount => undef });
175 } 'updated a money value to NULL';
177 is $rs->find($row->id)->amount, undef,'updated money value to NULL round-trip';
179 $schema->storage->dbh_do (sub {
180 my ($storage, $dbh) = @_;
181 eval { $dbh->do("DROP TABLE owners") };
182 eval { $dbh->do("DROP TABLE books") };
185 id INT IDENTITY (1, 1) NOT NULL,
192 CREATE TABLE owners (
193 id INT IDENTITY (1, 1) NOT NULL,
201 # start a new connection, make sure rebless works
202 my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
203 $schema->populate ('Owners', [
216 [qw/12 face_to_face/],
221 }, 'populate with PKs supplied ok' );
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);
229 $schema->resultset ('Owners')->create ({ id => $id, name => "troglodoogle $id" });
230 $schema->resultset ('Owners')->create ({ name => "troglodoogle " . ($id + 1) });
232 }, 'create with/without PKs ok' );
234 is ($schema->resultset ('Owners')->count, 19, 'owner rows really in db' );
237 # start a new connection, make sure rebless works
238 my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
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/],
255 }, 'populate without PKs supplied ok' );
257 # make sure ordered subselects work
259 my $owners = $schema->resultset ('Owners')->search ({}, { order_by => 'name' });
260 my $al = $owners->current_source_alias;
261 my $sealed_owners = $owners->result_source->resultset->search (
267 -source_handle => $owners->result_source->handle,
268 $al => $owners->as_query,
273 $schema->storage->debug (1);
275 my @subq_names = [ map { $_->name } ($sealed_owners->all) ];
276 my @names = [ map { $_->name } ($owners->all) ];
281 'Sort preserved from within a subquery'
282 ) || diag do { require Data::Dumper::Concise; Data::Dumper::Concise::Dumper (\@names, \@subq_names) };
283 $schema->storage->debug (0);
287 my $book_owner_ids = $schema->resultset ('BooksInLibrary')
288 ->search ({}, { join => 'owner', distinct => 1, order_by => 'owner.name' })
289 ->get_column ('owner');
291 my $book_owners = $schema->resultset ('Owners')->search ({
292 id => { -in => $book_owner_ids->as_query }
295 is ($book_owners->count, 8, 'Correct amount of book owners');
298 [ map { $_->id } ($book_owners->all) ],
299 [ $book_owner_ids->all ],
300 'Sort is preserved across IN subqueries',
304 # make sure right-join-side single-prefetch ordering limit works
306 my $rs = $schema->resultset ('BooksInLibrary')->search (
308 'owner.name' => { '!=', 'woggle' },
312 order_by => 'owner.name',
315 # this is the order in which they should come from the above query
316 my @owner_names = qw/boggle fISMBoC fREW fRIOUX fROOH fRUE wiggle wiggle/;
318 is ($rs->all, 8, 'Correct amount of objects from right-sorted joined resultset');
320 [map { $_->owner->name } ($rs->all) ],
322 'Rows were properly ordered'
325 my $limited_rs = $rs->search ({}, {rows => 7, offset => 2});
326 is ($limited_rs->count, 6, 'Correct count of limited right-sorted joined resultset');
327 is ($limited_rs->count_rs->next, 6, 'Correct count_rs of limited right-sorted joined resultset');
330 $schema->storage->debugcb(sub { $queries++; });
331 $schema->storage->debug(1);
334 [map { $_->owner->name } ($limited_rs->all) ],
335 [@owner_names[2 .. 7]],
336 'Limited rows were properly ordered'
338 is ($queries, 1, 'Only one query with prefetch');
340 $schema->storage->debugcb(undef);
341 $schema->storage->debug(0);
345 [map { $_->name } ($limited_rs->search_related ('owner')->all) ],
346 [@owner_names[2 .. 7]],
347 'Rows are still properly ordered after search_related'
353 # try a prefetch on tables with identically named columns
356 # set quote char - make sure things work while quoted
357 $schema->storage->_sql_maker->{quote_char} = [qw/[ ]/];
358 $schema->storage->_sql_maker->{name_sep} = '.';
361 # try a ->has_many direction
362 my $owners = $schema->resultset ('Owners')->search (
364 'books.id' => { '!=', undef },
365 'me.name' => { '!=', 'somebogusstring' },
369 order_by => { -asc => \['name + ?', [ test => 'xxx' ]] }, # test bindvar propagation
370 rows => 3, # 8 results total
374 my ($sql, @bind) = @${$owners->page(3)->as_query};
377 [ ([ 'me.name' => 'somebogusstring' ], [ test => 'xxx' ]) x 2 ], # double because of the prefetch subq
380 is ($owners->page(1)->all, 3, 'has_many prefetch returns correct number of rows');
381 is ($owners->page(1)->count, 3, 'has-many prefetch returns correct count');
383 is ($owners->page(3)->all, 2, 'has_many prefetch returns correct number of rows');
384 is ($owners->page(3)->count, 2, 'has-many prefetch returns correct count');
385 is ($owners->page(3)->count_rs->next, 2, 'has-many prefetch returns correct count_rs');
388 # try a ->belongs_to direction (no select collapse, group_by should work)
389 my $books = $schema->resultset ('BooksInLibrary')->search (
391 'owner.name' => [qw/wiggle woggle/],
395 having => \['1 = ?', [ test => 1 ] ], #test having propagation
397 rows => 2, # 3 results total
398 order_by => { -desc => 'owner' },
402 ($sql, @bind) = @${$books->page(3)->as_query};
407 [ 'owner.name' => 'wiggle' ], [ 'owner.name' => 'woggle' ], [ source => 'Library' ], [ test => '1' ],
409 [ 'owner.name' => 'wiggle' ], [ 'owner.name' => 'woggle' ], [ source => 'Library' ],
413 is ($books->page(1)->all, 2, 'Prefetched grouped search returns correct number of rows');
414 is ($books->page(1)->count, 2, 'Prefetched grouped search returns correct count');
416 is ($books->page(2)->all, 1, 'Prefetched grouped search returns correct number of rows');
417 is ($books->page(2)->count, 1, 'Prefetched grouped search returns correct count');
418 is ($books->page(2)->count_rs->next, 1, 'Prefetched grouped search returns correct count_rs');
423 # Just to aid bug-hunting, delete block before merging
426 my $limited_rs = $schema->resultset ('BooksInLibrary')->search (
428 'owner.name' => { '!=', 'woggle' },
432 order_by => 'owner.name',
443 SELECT me.id, me.surveyor_id, me.survey_site_id, me.year, surveyor.id, surveyor.name, surveyor.email, surveyor.phone, surveyor.login, surveyor.password, surveyor.is_active, surveyor.is_verifier, surveyor.arm_length, surveyor.eye_height, surveyor.year_joined
447 SELECT orig_query.*, ROW_NUMBER() OVER( ORDER BY (SELECT(1)) ) AS rno__row__index
449 SELECT me.id, me.surveyor_id, me.survey_site_id, me.year
451 SELECT TOP 100 PERCENT me.id, me.surveyor_id, me.survey_site_id, me.year
452 FROM surveyors_survey_sites me
453 JOIN surveyors surveyor ON surveyor.id = me.surveyor_id
454 ORDER BY surveyor.name
458 WHERE rno__row__index BETWEEN 136 AND 150
460 JOIN surveyors surveyor ON surveyor.id = me.surveyor_id
461 ORDER BY surveyor.name
465 $limited_rs->as_query,
467 SELECT TOP 100 PERCENT [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price], [owner].[id], [owner].[name]
471 SELECT [me].*, ROW_NUMBER() OVER( ORDER BY (SELECT(1)) ) AS rno__row__index
473 SELECT [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price]
475 SELECT TOP 100 PERCENT [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price]
477 JOIN [owners] [owner] ON [owner].[id] = [me].[owner]
478 WHERE ( ( [owner].[name] != ? AND [source] = ? ) )
479 ORDER BY [owner].[name]
483 WHERE rno__row__index BETWEEN 3 AND 9
485 JOIN [owners] [owner] ON [owner].[id] = [me].[owner]
486 WHERE ( ( [owner].[name] != ? AND [source] = ? ) )
487 ORDER BY [owner].[name]
489 [ ([ 'owner.name' => 'woggle' ], [ source => 'Library' ]) x 2 ],
490 'Expected SQL executed',
498 if (my $dbh = eval { $schema->storage->_dbh }) {
499 eval { $dbh->do("DROP TABLE $_") }
500 for qw/artist money_test books owners/;