[dbsrgits/DBIx-Class.git] / t / 746mssql.t

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   fREW/],
    [qw/5   fRIOUX/],
    [qw/6   fROOH/],
    [qw/7   fRUE/],
    [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 (1..2) {
    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' );

# make sure ordered subselects work
{
  my $book_owner_ids = $schema->resultset ('BooksInLibrary')
                               ->search ({}, { join => 'owner', distinct => 1, order_by => { -desc => 'owner'} })
                                ->get_column ('owner');

  my $owners = $schema->resultset ('Owners')->search ({
    id => { -in => $book_owner_ids->as_query }
  });

  is ($owners->count, 8, 'Correct amount of book owners');
  is ($owners->all, 8, 'Correct amount of book owner objects');
}

#
# 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
    },
  );

  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 => 'owner' },
    },
  );

  ($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');
}

# make sure right-join-side single-prefetch ordering limit works
{
  my $rs = $schema->resultset ('BooksInLibrary')->search (
    {
      'owner.name' => { '!=', 'woggle' },
    },
    {
      prefetch => 'owner',
      order_by => { -desc => 'owner.name' },
    }
  );

  is ($rs->all, 8, 'Correct amount of objects from right-sorted joined resultset');
  is_deeply (
    [map { $_->owner->name } ($rs->all) ],
    [qw/wiggle wiggle fRUE fROOH fRIOUX fREW fISMBoC boggle /],
    'Rows were properly ordered'
  );

  my $limited_rs = $rs->search ({}, {rows => 7, offset => 2});
  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) ],
    [qw/fRUE fROOH fRIOUX fREW fISMBoC boggle /],
    '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) ],
    [qw/fRUE fROOH fRIOUX fREW fISMBoC boggle /],
    'Rows are still properly ordered after search_related'
  );


# Just to aid bug-hunting, delete block before merging
{

=begin

Alan's SQL:

      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
        FROM (
          SELECT *
            FROM (
              SELECT orig_query.*, ROW_NUMBER() OVER( ORDER BY (SELECT(1)) ) AS rno__row__index
                FROM (
                  SELECT me.id, me.surveyor_id, me.survey_site_id, me.year
                    FROM (
                      SELECT TOP 100 PERCENT me.id, me.surveyor_id, me.survey_site_id, me.year
                        FROM surveyors_survey_sites me
                        JOIN surveyors surveyor ON surveyor.id = me.surveyor_id
                      ORDER BY surveyor.name
                    ) me
                ) orig_query
            ) rno_subq
          WHERE rno__row__index BETWEEN 136 AND 150 
        ) me
        JOIN surveyors surveyor ON surveyor.id = me.surveyor_id
      ORDER BY surveyor.name
=cut

  is_same_sql_bind (
    $limited_rs->as_query,
    '(
      SELECT TOP 100 PERCENT [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price], [owner].[id], [owner].[name]
        FROM (
          SELECT *
            FROM (
              SELECT [me].*, ROW_NUMBER() OVER( ORDER BY (SELECT(1)) ) AS rno__row__index 
                FROM (
                  SELECT [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price]
                    FROM (
                      SELECT TOP 100 PERCENT [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price]
                        FROM [books] [me]
                        JOIN [owners] [owner] ON [owner].[id] = [me].[owner]
                      WHERE ( ( [owner].[name] != ? AND [source] = ? ) )
                      ORDER BY [owner].[name] DESC
                    ) [me]
                ) [me]
            ) rno_subq
          WHERE rno__row__index BETWEEN 3 AND 9
        ) [me]
        JOIN [owners] [owner] ON [owner].[id] = [me].[owner]
      WHERE ( ( [owner].[name] != ? AND [source] = ? ) )
      ORDER BY [owner].[name] DESC
    )',
    [ ([ 'owner.name' => 'woggle' ], [ source => 'Library' ]) x 2 ],
    'Expected SQL executed',
  );
}

}

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
Commit	Line	Data
c1cac633	1	use strict;
b9a2c3a5	2	use warnings;
c1cac633	3
c1cac633	4	use Test::More;
893403c8	5	use Test::Exception;
c1cac633	6	use lib qw(t/lib);
c1cac633	7	use DBICTest;
b2d16f1f	8	use DBIC::SqlMakerTest;
c1cac633	9
	10	my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ODBC_${_}" } qw/DSN USER PASS/};
	11
	12	plan skip_all => 'Set $ENV{DBICTEST_MSSQL_ODBC_DSN}, _USER and _PASS to run this test'
	13	unless ($dsn && $user);
	14
ca791b95	15	DBICTest::Schema->load_classes('ArtistGUID');
42e5b103	16	my $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	29	isa_ok( $schema->storage, 'DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server' );
c1cac633	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	40	CREATE TABLE artist (
c1cac633	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)
c1cac633	46	)
c5f77f6c	47	SQL
c5f77f6c	48	});
c5f77f6c	49
c1cac633	50	my %seen_id;
c1cac633	51
7b1b2582	52	my @opts = (
	53	{ on_connect_call => 'use_dynamic_cursors' },
	54	{},
	55	);
	56	my $new;
2eebd801	57
7b1b2582	58	# test Auto-PK with different options
7b1b2582	59	for my $opts (@opts) {
41dd5d30	60	SKIP: {
41dd5d30	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
	83	for (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
	89	my $it = $schema->resultset('Artist')->search( {}, {
	90	rows => 3,
	91	order_by => 'artistid',
	92	});
	93
	94	is( $it->count, 3, "LIMIT count ok" );
	95	is( $it->next->name, "foo", "iterator->next ok" );
	96	$it->next;
	97	is( $it->next->name, "Artist 2", "iterator->next ok" );
	98	is( $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');
	106	CREATE 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	)
	114	SQL
	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	120	my $row;
	121	lives_ok {
	122	$row = $schema->resultset('ArtistGUID')->create({ name => 'mtfnpy' })
	123	} 'created a row with a GUID';
	124
	125	ok(
	126	eval { $row->artistid },
	127	'row has GUID PK col populated',
	128	);
	129	diag $@ if $@;
	130
	131	ok(
	132	eval { $row->a_guid },
	133	'row has a GUID col with auto_nextval populated',
	134	);
	135	diag $@ if $@;
	136
	137	my $row_from_db = $schema->resultset('ArtistGUID')
	138	->search({ name => 'mtfnpy' })->first;
	139
	140	is $row_from_db->artistid, $row->artistid,
	141	'PK GUID round trip';
	142
	143	is $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	151	CREATE TABLE money_test (
818ec409	152	id INT IDENTITY PRIMARY KEY,
5064f5c3	153	amount MONEY NULL
818ec409	154	)
818ec409	155	SQL
818ec409	156	});
	157
	158	my $rs = $schema->resultset('Money');
	159
818ec409	160	lives_ok {
d68f21ee	161	$row = $rs->create({ amount => 100 });
818ec409	162	} 'inserted a money value';
818ec409	163
a33d2444	164	cmp_ok $rs->find($row->id)->amount, '==', 100, 'money value round-trip';
818ec409	165
d68f21ee	166	lives_ok {
	167	$row->update({ amount => 200 });
	168	} 'updated a money value';
	169
a33d2444	170	cmp_ok $rs->find($row->id)->amount, '==', 200,
a33d2444	171	'updated money value round-trip';
d68f21ee	172
f6b185e1	173	lives_ok {
	174	$row->update({ amount => undef });
	175	} 'updated a money value to NULL';
	176
	177	is $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	184	CREATE 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
	192	CREATE TABLE Owners (
	193	id INT IDENTITY (1, 1) NOT NULL,
42e5b103	194	name VARCHAR(100),
b9a2c3a5	195	)
b9a2c3a5	196	SQL
	197
	198	});
893403c8	199
893403c8	200	lives_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	223	lives_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
	234	is ($schema->resultset ('Owners')->count, 19, 'owner rows really in db' );
	235
893403c8	236	lives_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	#
b9a2c3a5	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 (
6bc666a5	282	{
9010bab8	283	'books.id' => { '!=', undef },
9010bab8	284	'me.name' => { '!=', 'somebogusstring' },
6bc666a5	285	},
6bc666a5	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	},
6bc666a5	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 (
6bc666a5	309	{
56d2561e	310	'owner.name' => [qw/wiggle woggle/],
6bc666a5	311	},
6bc666a5	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	},
6bc666a5	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');
56d2561e	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
3670702b	340	# make sure right-join-side single-prefetch ordering limit works
b8d88d9b	341	{
	342	my $rs = $schema->resultset ('BooksInLibrary')->search (
	343	{
92f6e0b8	344	'owner.name' => { '!=', 'woggle' },
b8d88d9b	345	},
b8d88d9b	346	{
3670702b	347	prefetch => 'owner',
b8d88d9b	348	order_by => { -desc => 'owner.name' },
	349	}
	350	);
	351
92f6e0b8	352	is ($rs->all, 8, 'Correct amount of objects from right-sorted joined resultset');
	353	is_deeply (
	354	[map { $_->owner->name } ($rs->all) ],
	355	[qw/wiggle wiggle fRUE fROOH fRIOUX fREW fISMBoC boggle /],
	356	'Rows were properly ordered'
	357	);
	358
	359	my $limited_rs = $rs->search ({}, {rows => 7, offset => 2});
	360	is ($limited_rs->count, 6, 'Correct count of limited right-sorted joined resultset');
	361	is ($limited_rs->count_rs->next, 6, 'Correct count_rs of limited right-sorted joined resultset');
	362
	363	my $queries;
	364	$schema->storage->debugcb(sub { $queries++; });
	365	$schema->storage->debug(1);
	366
	367	is_deeply (
	368	[map { $_->owner->name } ($limited_rs->all) ],
	369	[qw/fRUE fROOH fRIOUX fREW fISMBoC boggle /],
	370	'Limited rows were properly ordered'
	371	);
	372	is ($queries, 1, 'Only one query with prefetch');
	373
	374	$schema->storage->debugcb(undef);
	375	$schema->storage->debug(0);
	376
444b791c	377
	378	is_deeply (
	379	[map { $_->name } ($limited_rs->search_related ('owner')->all) ],
92f6e0b8	380	[qw/fRUE fROOH fRIOUX fREW fISMBoC boggle /],
92f6e0b8	381	'Rows are still properly ordered after search_related'
444b791c	382	);
188c8576	383
	384
	385	# Just to aid bug-hunting, delete block before merging
	386	{
	387
	388	=begin
	389
	390	Alan's SQL:
	391
	392	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
	393	FROM (
	394	SELECT *
	395	FROM (
	396	SELECT orig_query.*, ROW_NUMBER() OVER( ORDER BY (SELECT(1)) ) AS rno__row__index
	397	FROM (
	398	SELECT me.id, me.surveyor_id, me.survey_site_id, me.year
	399	FROM (
	400	SELECT TOP 100 PERCENT me.id, me.surveyor_id, me.survey_site_id, me.year
	401	FROM surveyors_survey_sites me
	402	JOIN surveyors surveyor ON surveyor.id = me.surveyor_id
	403	ORDER BY surveyor.name
	404	) me
	405	) orig_query
	406	) rno_subq
	407	WHERE rno__row__index BETWEEN 136 AND 150
	408	) me
	409	JOIN surveyors surveyor ON surveyor.id = me.surveyor_id
	410	ORDER BY surveyor.name
	411	=cut
	412
	413	is_same_sql_bind (
	414	$limited_rs->as_query,
	415	'(
	416	SELECT TOP 100 PERCENT [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price], [owner].[id], [owner].[name]
	417	FROM (
	418	SELECT *
	419	FROM (
1f36ab67	420	SELECT [me].*, ROW_NUMBER() OVER( ORDER BY (SELECT(1)) ) AS rno__row__index
188c8576	421	FROM (
	422	SELECT [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price]
	423	FROM (
	424	SELECT TOP 100 PERCENT [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price]
	425	FROM [books] [me]
	426	JOIN [owners] [owner] ON [owner].[id] = [me].[owner]
	427	WHERE ( ( [owner].[name] != ? AND [source] = ? ) )
	428	ORDER BY [owner].[name] DESC
	429	) [me]
1f36ab67	430	) [me]
188c8576	431	) rno_subq
	432	WHERE rno__row__index BETWEEN 3 AND 9
	433	) [me]
	434	JOIN [owners] [owner] ON [owner].[id] = [me].[owner]
	435	WHERE ( ( [owner].[name] != ? AND [source] = ? ) )
	436	ORDER BY [owner].[name] DESC
	437	)',
	438	[ ([ 'owner.name' => 'woggle' ], [ source => 'Library' ]) x 2 ],
	439	'Expected SQL executed',
	440	);
	441	}
	442
b8d88d9b	443	}
b8d88d9b	444
afcfff01	445	done_testing;
afcfff01	446
c1cac633	447	# clean up our mess
c1cac633	448	END {
ca791b95	449	if (my $dbh = eval { $schema->storage->_dbh }) {
	450	eval { $dbh->do("DROP TABLE $_") }
	451	for qw/artist money_test Books Owners/;
	452	}
c1cac633	453	}
fc85215b	454	# vim:sw=2 sts=2