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,
274 [ map { $_->name } ($sealed_owners->all) ],
275 [ map { $_->name } ($owners->all) ],
276 'Sort preserved from within a subquery',
281 local $TODO = "This porbably will never work, but it isn't critical either afaik";
283 my $book_owner_ids = $schema->resultset ('BooksInLibrary')
284 ->search ({}, { join => 'owner', distinct => 1, order_by => 'owner.name' })
285 ->get_column ('owner');
287 my $book_owners = $schema->resultset ('Owners')->search ({
288 id => { -in => $book_owner_ids->as_query }
292 [ map { $_->id } ($book_owners->all) ],
293 [ $book_owner_ids->all ],
294 'Sort is preserved across IN subqueries',
298 # make sure right-join-side single-prefetch ordering limit works
300 my $rs = $schema->resultset ('BooksInLibrary')->search (
302 'owner.name' => { '!=', 'woggle' },
306 order_by => 'owner.name',
309 # this is the order in which they should come from the above query
310 my @owner_names = qw/boggle fISMBoC fREW fRIOUX fROOH fRUE wiggle wiggle/;
312 is ($rs->all, 8, 'Correct amount of objects from right-sorted joined resultset');
314 [map { $_->owner->name } ($rs->all) ],
316 'Rows were properly ordered'
319 my $limited_rs = $rs->search ({}, {rows => 7, offset => 2});
320 is ($limited_rs->count, 6, 'Correct count of limited right-sorted joined resultset');
321 is ($limited_rs->count_rs->next, 6, 'Correct count_rs of limited right-sorted joined resultset');
324 $schema->storage->debugcb(sub { $queries++; });
325 $schema->storage->debug(1);
328 [map { $_->owner->name } ($limited_rs->all) ],
329 [@owner_names[2 .. 7]],
330 'Limited rows were properly ordered'
332 is ($queries, 1, 'Only one query with prefetch');
334 $schema->storage->debugcb(undef);
335 $schema->storage->debug(0);
339 [map { $_->name } ($limited_rs->search_related ('owner')->all) ],
340 [@owner_names[2 .. 7]],
341 'Rows are still properly ordered after search_related'
347 # try a prefetch on tables with identically named columns
350 # set quote char - make sure things work while quoted
351 $schema->storage->_sql_maker->{quote_char} = [qw/[ ]/];
352 $schema->storage->_sql_maker->{name_sep} = '.';
355 # try a ->has_many direction
356 my $owners = $schema->resultset ('Owners')->search (
358 'books.id' => { '!=', undef },
359 'me.name' => { '!=', 'somebogusstring' },
363 order_by => { -asc => \['name + ?', [ test => 'xxx' ]] }, # test bindvar propagation
364 rows => 3, # 8 results total
368 my ($sql, @bind) = @${$owners->page(3)->as_query};
371 [ ([ 'me.name' => 'somebogusstring' ], [ test => 'xxx' ]) x 2 ], # double because of the prefetch subq
374 is ($owners->page(1)->all, 3, 'has_many prefetch returns correct number of rows');
375 is ($owners->page(1)->count, 3, 'has-many prefetch returns correct count');
377 is ($owners->page(3)->all, 2, 'has_many prefetch returns correct number of rows');
378 is ($owners->page(3)->count, 2, 'has-many prefetch returns correct count');
379 is ($owners->page(3)->count_rs->next, 2, 'has-many prefetch returns correct count_rs');
382 # try a ->belongs_to direction (no select collapse, group_by should work)
383 my $books = $schema->resultset ('BooksInLibrary')->search (
385 'owner.name' => [qw/wiggle woggle/],
389 having => \['1 = ?', [ test => 1 ] ], #test having propagation
391 rows => 2, # 3 results total
392 order_by => { -desc => 'owner' },
396 ($sql, @bind) = @${$books->page(3)->as_query};
401 [ 'owner.name' => 'wiggle' ], [ 'owner.name' => 'woggle' ], [ source => 'Library' ], [ test => '1' ],
403 [ 'owner.name' => 'wiggle' ], [ 'owner.name' => 'woggle' ], [ source => 'Library' ],
407 is ($books->page(1)->all, 2, 'Prefetched grouped search returns correct number of rows');
408 is ($books->page(1)->count, 2, 'Prefetched grouped search returns correct count');
410 is ($books->page(2)->all, 1, 'Prefetched grouped search returns correct number of rows');
411 is ($books->page(2)->count, 1, 'Prefetched grouped search returns correct count');
412 is ($books->page(2)->count_rs->next, 1, 'Prefetched grouped search returns correct count_rs');
419 if (my $dbh = eval { $schema->storage->_dbh }) {
420 eval { $dbh->do("DROP TABLE $_") }
421 for qw/artist money_test books owners/;