use strict; use warnings; use Test::More; use Test::Exception; use lib qw(t/lib); use DBICTest; use DBIC::SqlMakerTest; my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ODBC_${_}" } qw/DSN USER PASS/}; plan skip_all => 'Set $ENV{DBICTEST_MSSQL_ODBC_DSN}, _USER and _PASS to run this test' unless ($dsn && $user); DBICTest::Schema->load_classes('ArtistGUID'); my $schema = DBICTest::Schema->connect($dsn, $user, $pass); { no warnings 'redefine'; my $connect_count = 0; my $orig_connect = \&DBI::connect; local *DBI::connect = sub { $connect_count++; goto &$orig_connect }; $schema->storage->ensure_connected; is( $connect_count, 1, 'only one connection made'); } isa_ok( $schema->storage, 'DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server' ); { my $schema2 = $schema->connect ($schema->storage->connect_info); ok (! $schema2->storage->connected, 'a re-connected cloned schema starts unconnected'); } $schema->storage->dbh_do (sub { my ($storage, $dbh) = @_; eval { $dbh->do("DROP TABLE artist") }; $dbh->do(<<'SQL'); CREATE TABLE artist ( artistid INT IDENTITY NOT NULL, name VARCHAR(100), rank INT NOT NULL DEFAULT '13', charfield CHAR(10) NULL, primary key(artistid) ) SQL }); my %seen_id; my @opts = ( { on_connect_call => 'use_dynamic_cursors' }, {}, ); my $new; # test Auto-PK with different options for my $opts (@opts) { SKIP: { $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts); eval { $schema->storage->ensure_connected }; if ($@ =~ /dynamic cursors/) { skip 'Dynamic Cursors not functional, tds_version 8.0 or greater required if using'. ' FreeTDS', 1; } $schema->resultset('Artist')->search({ name => 'foo' })->delete; $new = $schema->resultset('Artist')->create({ name => 'foo' }); ok($new->artistid > 0, "Auto-PK worked"); } } $seen_id{$new->artistid}++; # test LIMIT support for (1..6) { $new = $schema->resultset('Artist')->create({ name => 'Artist ' . $_ }); is ( $seen_id{$new->artistid}, undef, "id for Artist $_ is unique" ); $seen_id{$new->artistid}++; } my $it = $schema->resultset('Artist')->search( {}, { rows => 3, order_by => 'artistid', }); is( $it->count, 3, "LIMIT count ok" ); is( $it->next->name, "foo", "iterator->next ok" ); $it->next; is( $it->next->name, "Artist 2", "iterator->next ok" ); is( $it->next, undef, "next past end of resultset ok" ); # test GUID columns $schema->storage->dbh_do (sub { my ($storage, $dbh) = @_; eval { $dbh->do("DROP TABLE artist") }; $dbh->do(<<'SQL'); CREATE TABLE artist ( artistid UNIQUEIDENTIFIER NOT NULL, name VARCHAR(100), rank INT NOT NULL DEFAULT '13', charfield CHAR(10) NULL, a_guid UNIQUEIDENTIFIER, primary key(artistid) ) SQL }); # start disconnected to make sure insert works on an un-reblessed storage $schema = DBICTest::Schema->connect($dsn, $user, $pass); my $row; lives_ok { $row = $schema->resultset('ArtistGUID')->create({ name => 'mtfnpy' }) } 'created a row with a GUID'; ok( eval { $row->artistid }, 'row has GUID PK col populated', ); diag $@ if $@; ok( eval { $row->a_guid }, 'row has a GUID col with auto_nextval populated', ); diag $@ if $@; my $row_from_db = $schema->resultset('ArtistGUID') ->search({ name => 'mtfnpy' })->first; is $row_from_db->artistid, $row->artistid, 'PK GUID round trip'; is $row_from_db->a_guid, $row->a_guid, 'NON-PK GUID round trip'; # test MONEY type $schema->storage->dbh_do (sub { my ($storage, $dbh) = @_; eval { $dbh->do("DROP TABLE money_test") }; $dbh->do(<<'SQL'); CREATE TABLE money_test ( id INT IDENTITY PRIMARY KEY, amount MONEY NULL ) SQL }); my $rs = $schema->resultset('Money'); lives_ok { $row = $rs->create({ amount => 100 }); } 'inserted a money value'; cmp_ok $rs->find($row->id)->amount, '==', 100, 'money value round-trip'; lives_ok { $row->update({ amount => 200 }); } 'updated a money value'; cmp_ok $rs->find($row->id)->amount, '==', 200, 'updated money value round-trip'; lives_ok { $row->update({ amount => undef }); } 'updated a money value to NULL'; is $rs->find($row->id)->amount, undef,'updated money value to NULL round-trip'; $schema->storage->dbh_do (sub { my ($storage, $dbh) = @_; eval { $dbh->do("DROP TABLE owners") }; eval { $dbh->do("DROP TABLE books") }; $dbh->do(<<'SQL'); CREATE TABLE books ( id INT IDENTITY (1, 1) NOT NULL, source VARCHAR(100), owner INT, title VARCHAR(10), price INT NULL ) CREATE TABLE owners ( id INT IDENTITY (1, 1) NOT NULL, name VARCHAR(100), ) SQL }); lives_ok ( sub { # start a new connection, make sure rebless works my $schema = DBICTest::Schema->connect($dsn, $user, $pass); $schema->populate ('Owners', [ [qw/id name /], [qw/1 wiggle/], [qw/2 woggle/], [qw/3 boggle/], [qw/4 fRIOUX/], [qw/5 fRUE/], [qw/6 fREW/], [qw/7 fROOH/], [qw/8 fISMBoC/], [qw/9 station/], [qw/10 mirror/], [qw/11 dimly/], [qw/12 face_to_face/], [qw/13 icarus/], [qw/14 dream/], [qw/15 dyrstyggyr/], ]); }, 'populate with PKs supplied ok' ); lives_ok (sub { # start a new connection, make sure rebless works # test an insert with a supplied identity, followed by one without my $schema = DBICTest::Schema->connect($dsn, $user, $pass); for (2, 1) { my $id = $_ * 20 ; $schema->resultset ('Owners')->create ({ id => $id, name => "troglodoogle $id" }); $schema->resultset ('Owners')->create ({ name => "troglodoogle " . ($id + 1) }); } }, 'create with/without PKs ok' ); is ($schema->resultset ('Owners')->count, 19, 'owner rows really in db' ); lives_ok ( sub { # start a new connection, make sure rebless works my $schema = DBICTest::Schema->connect($dsn, $user, $pass); $schema->populate ('BooksInLibrary', [ [qw/source owner title /], [qw/Library 1 secrets0/], [qw/Library 1 secrets1/], [qw/Eatery 1 secrets2/], [qw/Library 2 secrets3/], [qw/Library 3 secrets4/], [qw/Eatery 3 secrets5/], [qw/Library 4 secrets6/], [qw/Library 5 secrets7/], [qw/Eatery 5 secrets8/], [qw/Library 6 secrets9/], [qw/Library 7 secrets10/], [qw/Eatery 7 secrets11/], [qw/Library 8 secrets12/], ]); }, 'populate without PKs supplied ok' ); # plain ordered subqueries throw throws_ok (sub { $schema->resultset('Owners')->search ({}, { order_by => 'name' })->as_query }, qr/ordered subselect encountered/, 'Ordered Subselect detection throws ok'); # make sure ordered subselects *somewhat* work { my $owners = $schema->resultset ('Owners')->search ({}, { order_by => 'name', offset => 2, rows => 3, unsafe_subselect_ok => 1 }); my $al = $owners->current_source_alias; my $sealed_owners = $owners->result_source->resultset->search ( {}, { alias => $al, from => [{ -alias => $al, -source_handle => $owners->result_source->handle, $al => $owners->as_query, }], }, ); is_deeply ( [ map { $_->name } ($sealed_owners->all) ], [ map { $_->name } ($owners->all) ], 'Sort preserved from within a subquery', ); } TODO: { local $TODO = "This porbably will never work, but it isn't critical either afaik"; my $book_owner_ids = $schema->resultset ('BooksInLibrary') ->search ({}, { join => 'owner', distinct => 1, order_by => 'owner.name', unsafe_subselect_ok => 1 }) ->get_column ('owner'); my $book_owners = $schema->resultset ('Owners')->search ({ id => { -in => $book_owner_ids->as_query } }); is_deeply ( [ map { $_->id } ($book_owners->all) ], [ $book_owner_ids->all ], 'Sort is preserved across IN subqueries', ); } # This is known not to work - thus the negative test { my $owners = $schema->resultset ('Owners')->search ({}, { order_by => 'name', offset => 2, rows => 3, unsafe_subselect_ok => 1 }); my $corelated_owners = $owners->result_source->resultset->search ( { id => { -in => $owners->get_column('id')->as_query }, }, { order_by => 'name' #reorder because of what is shown above }, ); cmp_ok ( join ("\x00", map { $_->name } ($corelated_owners->all) ), 'ne', join ("\x00", map { $_->name } ($owners->all) ), 'Sadly sort not preserved from within a corelated subquery', ); cmp_ok ( join ("\x00", sort map { $_->name } ($corelated_owners->all) ), 'ne', join ("\x00", sort map { $_->name } ($owners->all) ), 'Which in fact gives a completely wrong dataset', ); } # make sure right-join-side single-prefetch ordering limit works { my $rs = $schema->resultset ('BooksInLibrary')->search ( { 'owner.name' => { '!=', 'woggle' }, }, { prefetch => 'owner', order_by => 'owner.name', } ); # this is the order in which they should come from the above query my @owner_names = qw/boggle fISMBoC fREW fRIOUX fROOH fRUE wiggle wiggle/; is ($rs->all, 8, 'Correct amount of objects from right-sorted joined resultset'); is_deeply ( [map { $_->owner->name } ($rs->all) ], \@owner_names, 'Rows were properly ordered' ); my $limited_rs = $rs->search ({}, {rows => 7, offset => 2, unsafe_subselect_ok => 1}); is ($limited_rs->count, 6, 'Correct count of limited right-sorted joined resultset'); is ($limited_rs->count_rs->next, 6, 'Correct count_rs of limited right-sorted joined resultset'); my $queries; $schema->storage->debugcb(sub { $queries++; }); $schema->storage->debug(1); is_deeply ( [map { $_->owner->name } ($limited_rs->all) ], [@owner_names[2 .. 7]], 'Limited rows were properly ordered' ); is ($queries, 1, 'Only one query with prefetch'); $schema->storage->debugcb(undef); $schema->storage->debug(0); is_deeply ( [map { $_->name } ($limited_rs->search_related ('owner')->all) ], [@owner_names[2 .. 7]], 'Rows are still properly ordered after search_related' ); } # # try a prefetch on tables with identically named columns # # set quote char - make sure things work while quoted $schema->storage->_sql_maker->{quote_char} = [qw/[ ]/]; $schema->storage->_sql_maker->{name_sep} = '.'; { # try a ->has_many direction my $owners = $schema->resultset ('Owners')->search ( { 'books.id' => { '!=', undef }, 'me.name' => { '!=', 'somebogusstring' }, }, { prefetch => 'books', order_by => { -asc => \['name + ?', [ test => 'xxx' ]] }, # test bindvar propagation rows => 3, # 8 results total unsafe_subselect_ok => 1, }, ); my ($sql, @bind) = @${$owners->page(3)->as_query}; is_deeply ( \@bind, [ ([ 'me.name' => 'somebogusstring' ], [ test => 'xxx' ]) x 2 ], # double because of the prefetch subq ); is ($owners->page(1)->all, 3, 'has_many prefetch returns correct number of rows'); is ($owners->page(1)->count, 3, 'has-many prefetch returns correct count'); is ($owners->page(3)->all, 2, 'has_many prefetch returns correct number of rows'); is ($owners->page(3)->count, 2, 'has-many prefetch returns correct count'); is ($owners->page(3)->count_rs->next, 2, 'has-many prefetch returns correct count_rs'); # try a ->belongs_to direction (no select collapse, group_by should work) my $books = $schema->resultset ('BooksInLibrary')->search ( { 'owner.name' => [qw/wiggle woggle/], }, { distinct => 1, having => \['1 = ?', [ test => 1 ] ], #test having propagation prefetch => 'owner', rows => 2, # 3 results total order_by => { -desc => 'me.owner' }, unsafe_subselect_ok => 1, }, ); ($sql, @bind) = @${$books->page(3)->as_query}; is_deeply ( \@bind, [ # inner [ 'owner.name' => 'wiggle' ], [ 'owner.name' => 'woggle' ], [ source => 'Library' ], [ test => '1' ], # outer [ 'owner.name' => 'wiggle' ], [ 'owner.name' => 'woggle' ], [ source => 'Library' ], ], ); is ($books->page(1)->all, 2, 'Prefetched grouped search returns correct number of rows'); is ($books->page(1)->count, 2, 'Prefetched grouped search returns correct count'); is ($books->page(2)->all, 1, 'Prefetched grouped search returns correct number of rows'); is ($books->page(2)->count, 1, 'Prefetched grouped search returns correct count'); is ($books->page(2)->count_rs->next, 1, 'Prefetched grouped search returns correct count_rs'); } done_testing; # clean up our mess END { if (my $dbh = eval { $schema->storage->_dbh }) { eval { $dbh->do("DROP TABLE $_") } for qw/artist money_test books owners/; } } # vim:sw=2 sts=2