[dbsrgits/DBIx-Class.git] / t / 747mssql_ado.t

use strict;
use warnings;

use Test::More;
use Test::Exception;
use Try::Tiny;
use DBIx::Class::Optional::Dependencies ();
use lib qw(t/lib);
use DBICTest;

plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_mssql_ado')
  unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_mssql_ado');

# Example DSN (from frew):
# dbi:ADO:PROVIDER=sqlncli10;SERVER=tcp:172.24.2.10;MARS Connection=True;Initial Catalog=CIS;UID=cis_web;PWD=...;DataTypeCompatibility=80;

my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ADO_${_}" } qw/DSN USER PASS/};

plan skip_all => 'Set $ENV{DBICTEST_MSSQL_ADO_DSN}, _USER and _PASS to run this test'
  unless ($dsn && $user);

require DBICTest::Schema;
DBICTest::Schema->load_classes(qw/VaryingMAX ArtistGUID/);

my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) );
$binstr{'large'} = $binstr{'small'} x 1024;

my $maxloblen = length $binstr{'large'};

my $schema = DBICTest::Schema->connect($dsn, $user, $pass, {
  auto_savepoint => 1,
  LongReadLen => $maxloblen,
});

$schema->storage->ensure_connected;

isa_ok($schema->storage, 'DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server');

my $ver = $schema->storage->_server_info->{normalized_dbms_version};

ok $ver, 'can introspect DBMS version';

# 2005 and greater
is $schema->storage->sql_limit_dialect, ($ver >= 9 ? 'RowNumberOver' : 'Top'),
  'correct limit dialect detected';

$schema->storage->dbh_do (sub {
    my ($storage, $dbh) = @_;
    try { local $^W = 0; $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
});

$schema->storage->dbh_do (sub {
  my ($storage, $dbh) = @_;
  try { local $^W = 0; $dbh->do("DROP TABLE artist_guid") };
  $dbh->do(<<"SQL");
CREATE TABLE artist_guid (
 artistid UNIQUEIDENTIFIER NOT NULL,
 name VARCHAR(100),
 rank INT NULL,
 charfield CHAR(10) NULL,
 a_guid UNIQUEIDENTIFIER,
 primary key(artistid)
)
SQL
});

my $have_max = $ver >= 9; # 2005 and greater

$schema->storage->dbh_do (sub {
    my ($storage, $dbh) = @_;
    try { local $^W = 0; $dbh->do("DROP TABLE varying_max_test") };
    $dbh->do("
CREATE TABLE varying_max_test (
   id INT IDENTITY NOT NULL,
" . ($have_max ? "
   varchar_max VARCHAR(MAX),
   nvarchar_max NVARCHAR(MAX),
   varbinary_max VARBINARY(MAX),
" : "
   varchar_max TEXT,
   nvarchar_max NTEXT,
   varbinary_max IMAGE,
") . "
   primary key(id)
)");
});

my $ars = $schema->resultset('Artist');

my $new = $ars->create({ name => 'foo' });
ok($new->artistid > 0, 'Auto-PK worked');

# make sure select works
my $found = $schema->resultset('Artist')->search({ name => 'foo' })->first;
is $found->artistid, $new->artistid, 'search works';

# test large column list in select
$found = $schema->resultset('Artist')->search({ name => 'foo' }, {
  select => ['artistid', 'name', map \"'foo' foo_$_", 0..50],
  as     => ['artistid', 'name', map        "foo_$_", 0..50],
})->first;
is $found->artistid, $new->artistid, 'select with big column list';
is $found->get_column('foo_50'), 'foo', 'last item in big column list';

# create a few more rows
for (1..12) {
  $schema->resultset('Artist')->create({ name => 'Artist ' . $_ });
}

# test multiple active cursors
my $rs1 = $schema->resultset('Artist')->search({}, { order_by => 'artistid' });
my $rs2 = $schema->resultset('Artist')->search({}, { order_by => 'name' });

while ($rs1->next) {
  ok try { $rs2->next }, 'multiple active cursors';
}

# test bug where ADO blows up if the first bindparam is shorter than the second
is $schema->resultset('Artist')->search({ artistid => 2 })->first->name,
  'Artist 1',
  'short bindparam';

is $schema->resultset('Artist')->search({ artistid => 13 })->first->name,
  'Artist 12',
  'longer bindparam';

# test explicit key spec
$new = $ars->create ({ name => 'bar', artistid => 66 });
is($new->artistid, 66, 'Explicit PK worked');
$new->discard_changes;
is($new->artistid, 66, 'Explicit PK assigned');

# test basic transactions
$schema->txn_do(sub {
  $ars->create({ name => 'transaction_commit' });
});
ok($ars->search({ name => 'transaction_commit' })->first,
  'transaction committed');
$ars->search({ name => 'transaction_commit' })->delete,
throws_ok {
  $schema->txn_do(sub {
    $ars->create({ name => 'transaction_rollback' });
    die 'rolling back';
  });
} qr/rolling back/, 'rollback executed';
is $ars->search({ name => 'transaction_rollback' })->first, undef,
  'transaction rolled back';

# test two-phase commit and inner transaction rollback from nested transactions
$schema->txn_do(sub {
  $ars->create({ name => 'in_outer_transaction' });
  $schema->txn_do(sub {
    $ars->create({ name => 'in_inner_transaction' });
  });
  ok($ars->search({ name => 'in_inner_transaction' })->first,
    'commit from inner transaction visible in outer transaction');
  throws_ok {
    $schema->txn_do(sub {
      $ars->create({ name => 'in_inner_transaction_rolling_back' });
      die 'rolling back inner transaction';
    });
  } qr/rolling back inner transaction/, 'inner transaction rollback executed';
});
ok($ars->search({ name => 'in_outer_transaction' })->first,
  'commit from outer transaction');
ok($ars->search({ name => 'in_inner_transaction' })->first,
  'commit from inner transaction');
is $ars->search({ name => 'in_inner_transaction_rolling_back' })->first,
  undef,
  'rollback from inner transaction';
$ars->search({ name => 'in_outer_transaction' })->delete;
$ars->search({ name => 'in_inner_transaction' })->delete;

# test populate
lives_ok (sub {
  my @pop;
  for (1..2) {
    push @pop, { name => "Artist_$_" };
  }
  $ars->populate (\@pop);
});

# test populate with explicit key
lives_ok (sub {
  my @pop;
  for (1..2) {
    push @pop, { name => "Artist_expkey_$_", artistid => 100 + $_ };
  }
  $ars->populate (\@pop);
});

# count what we did so far
is ($ars->count, 18, 'Simple count works');

# test empty insert
my $current_artistid = $ars->search({}, {
  select => [ { max => 'artistid' } ], as => ['artistid']
})->first->artistid;

my $row;
lives_ok { $row = $ars->create({}) }
  'empty insert works';

$row->discard_changes;

is $row->artistid, $current_artistid+1,
  'empty insert generated correct PK';

# test that autoinc column still works after empty insert
  $row = $ars->create({ name => 'after_empty_insert' });

  is $row->artistid, $current_artistid+2,
    'autoincrement column functional aftear empty insert';

my $rs = $schema->resultset('VaryingMAX');

foreach my $size (qw/small large/) {
  local $schema->storage->{debug} = 0 if $size eq 'large';

  my $str = $binstr{$size};
  my $row;
  lives_ok {
    $row = $rs->create({
      varchar_max => $str, nvarchar_max => $str, varbinary_max => $str
    });
  } "created $size VARXXX(MAX) LOBs";

  lives_ok {
    $row->discard_changes;
  } 're-selected just-inserted LOBs';

  cmp_ok try { $row->varchar_max },   'eq', $str, 'VARCHAR(MAX) matches';
  cmp_ok try { $row->nvarchar_max },  'eq', $str, 'NVARCHAR(MAX) matches';
  cmp_ok try { $row->varbinary_max }, 'eq', $str, 'VARBINARY(MAX) matches';
}

# test regular blobs

try { local $^W = 0; $schema->storage->dbh->do('DROP TABLE bindtype_test') };
$schema->storage->dbh->do(qq[
CREATE TABLE bindtype_test
(
  id     INT IDENTITY NOT NULL PRIMARY KEY,
  bytea  INT NULL,
  blob   IMAGE NULL,
  clob   TEXT NULL,
  a_memo NTEXT NULL
)
],{ RaiseError => 1, PrintError => 1 });

$rs = $schema->resultset('BindType');
my $id = 0;

foreach my $type (qw( blob clob a_memo )) {
  foreach my $size (qw( small large )) {
    $id++;

    lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) }
      "inserted $size $type without dying" or next;

    my $from_db = eval { $rs->find($id)->$type } || '';
    diag $@ if $@;

    ok($from_db eq $binstr{$size}, "verified inserted $size $type" )
      or do {
        my $hexdump = sub {
          join '', map sprintf('%02X', ord), split //, shift
        };
        diag 'Got: ', "\n", substr($hexdump->($from_db),0,255), '...',
          substr($hexdump->($from_db),-255);
        diag 'Size: ', length($from_db);
        diag 'Expected Size: ', length($binstr{$size});
        diag 'Expected: ', "\n",
          substr($hexdump->($binstr{$size}), 0, 255),
          "...", substr($hexdump->($binstr{$size}),-255);
      };
  }
}
# test IMAGE update
lives_ok {
  $rs->search({ id => 0 })->update({ blob => $binstr{small} });
} 'updated IMAGE to small binstr without dying';

lives_ok {
  $rs->search({ id => 0 })->update({ blob => $binstr{large} });
} 'updated IMAGE to large binstr without dying';

# test GUIDs
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 $@;

my $guid = try { $row->artistid }||'';

ok(($guid !~ /^{.*?}\z/), 'GUID not enclosed in braces')
  or diag "GUID is: $guid";

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 try { $row_from_db->artistid }, try { $row->artistid },
  'PK GUID round trip (via ->search->next)';

is try { $row_from_db->a_guid }, try { $row->a_guid },
  'NON-PK GUID round trip (via ->search->next)';

$row_from_db = try { $schema->resultset('ArtistGUID')
  ->find($row->artistid) };

is try { $row_from_db->artistid }, try { $row->artistid },
  'PK GUID round trip (via ->find)';

is try { $row_from_db->a_guid }, try { $row->a_guid },
  'NON-PK GUID round trip (via ->find)';

($row_from_db) = $schema->resultset('ArtistGUID')
  ->search({ name => 'mtfnpy' })->all;

is try { $row_from_db->artistid }, try { $row->artistid },
  'PK GUID round trip (via ->search->all)';

is try { $row_from_db->a_guid }, try { $row->a_guid },
  'NON-PK GUID round trip (via ->search->all)';

lives_ok {
  $row = $schema->resultset('ArtistGUID')->create({
      artistid => '70171270-4822-4450-81DF-921F99BA3C06',
      name => 'explicit_guid',
  });
} 'created a row with explicit PK GUID';

is try { $row->artistid }, '70171270-4822-4450-81DF-921F99BA3C06',
  'row has correct PK GUID';

lives_ok {
  $row->update({ artistid => '70171270-4822-4450-81DF-921F99BA3C07' });
} "updated row's PK GUID";

is try { $row->artistid }, '70171270-4822-4450-81DF-921F99BA3C07',
  'row has correct PK GUID';

lives_ok {
  $row->delete;
} 'deleted the row';

lives_ok {
  $schema->resultset('ArtistGUID')->populate([{
      artistid => '70171270-4822-4450-81DF-921F99BA3C06',
      name => 'explicit_guid',
  }]);
} 'created a row with explicit PK GUID via ->populate in void context';

done_testing;

# clean up our mess
END {
  local $SIG{__WARN__} = sub {};
  if (my $dbh = try { $schema->storage->_dbh }) {
    (try { $dbh->do("DROP TABLE $_") })
      for qw/artist artist_guid varying_max_test bindtype_test/;
  }

  undef $schema;
}
# vim:sw=2 sts=2
Commit	Line	Data
4ffa5700	1	use strict;
	2	use warnings;
	3
	4	use Test::More;
2edf3352	5	use Test::Exception;
2edf3352	6	use Try::Tiny;
199fbc45	7	use DBIx::Class::Optional::Dependencies ();
4ffa5700	8	use lib qw(t/lib);
	9	use DBICTest;
	10
199fbc45	11	plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_mssql_ado')
	12	unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_mssql_ado');
	13
56dca25f	14	# Example DSN (from frew):
	15	# dbi:ADO:PROVIDER=sqlncli10;SERVER=tcp:172.24.2.10;MARS Connection=True;Initial Catalog=CIS;UID=cis_web;PWD=...;DataTypeCompatibility=80;
	16
4ffa5700	17	my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ADO_${_}" } qw/DSN USER PASS/};
	18
	19	plan skip_all => 'Set $ENV{DBICTEST_MSSQL_ADO_DSN}, _USER and _PASS to run this test'
	20	unless ($dsn && $user);
	21
2c2bc4e5	22	require DBICTest::Schema;
2edf3352	23	DBICTest::Schema->load_classes(qw/VaryingMAX ArtistGUID/);
	24
	25	my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) );
	26	$binstr{'large'} = $binstr{'small'} x 1024;
	27
	28	my $maxloblen = length $binstr{'large'};
	29
	30	my $schema = DBICTest::Schema->connect($dsn, $user, $pass, {
	31	auto_savepoint => 1,
	32	LongReadLen => $maxloblen,
	33	});
	34
4ffa5700	35	$schema->storage->ensure_connected;
4ffa5700	36
2edf3352	37	isa_ok($schema->storage, 'DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server');
4ffa5700	38
56dca25f	39	my $ver = $schema->storage->_server_info->{normalized_dbms_version};
	40
	41	ok $ver, 'can introspect DBMS version';
	42
2edf3352	43	# 2005 and greater
56dca25f	44	is $schema->storage->sql_limit_dialect, ($ver >= 9 ? 'RowNumberOver' : 'Top'),
	45	'correct limit dialect detected';
	46
4ffa5700	47	$schema->storage->dbh_do (sub {
4ffa5700	48	my ($storage, $dbh) = @_;
2edf3352	49	try { local $^W = 0; $dbh->do("DROP TABLE artist") };
4ffa5700	50	$dbh->do(<<'SQL');
	51	CREATE TABLE artist (
	52	artistid INT IDENTITY NOT NULL,
	53	name VARCHAR(100),
	54	rank INT NOT NULL DEFAULT '13',
	55	charfield CHAR(10) NULL,
	56	primary key(artistid)
	57	)
	58	SQL
	59	});
	60
2edf3352	61	$schema->storage->dbh_do (sub {
	62	my ($storage, $dbh) = @_;
	63	try { local $^W = 0; $dbh->do("DROP TABLE artist_guid") };
	64	$dbh->do(<<"SQL");
	65	CREATE TABLE artist_guid (
	66	artistid UNIQUEIDENTIFIER NOT NULL,
	67	name VARCHAR(100),
	68	rank INT NULL,
	69	charfield CHAR(10) NULL,
	70	a_guid UNIQUEIDENTIFIER,
	71	primary key(artistid)
	72	)
	73	SQL
	74	});
	75
	76	my $have_max = $ver >= 9; # 2005 and greater
	77
	78	$schema->storage->dbh_do (sub {
	79	my ($storage, $dbh) = @_;
	80	try { local $^W = 0; $dbh->do("DROP TABLE varying_max_test") };
	81	$dbh->do("
	82	CREATE TABLE varying_max_test (
	83	id INT IDENTITY NOT NULL,
	84	" . ($have_max ? "
	85	varchar_max VARCHAR(MAX),
	86	nvarchar_max NVARCHAR(MAX),
	87	varbinary_max VARBINARY(MAX),
	88	" : "
	89	varchar_max TEXT,
	90	nvarchar_max NTEXT,
	91	varbinary_max IMAGE,
	92	") . "
	93	primary key(id)
	94	)");
	95	});
	96
	97	my $ars = $schema->resultset('Artist');
	98
	99	my $new = $ars->create({ name => 'foo' });
4ffa5700	100	ok($new->artistid > 0, 'Auto-PK worked');
	101
	102	# make sure select works
	103	my $found = $schema->resultset('Artist')->search({ name => 'foo' })->first;
	104	is $found->artistid, $new->artistid, 'search works';
	105
7282bf38	106	# test large column list in select
7282bf38	107	$found = $schema->resultset('Artist')->search({ name => 'foo' }, {
56dca25f	108	select => ['artistid', 'name', map \"'foo' foo_$_", 0..50],
56dca25f	109	as => ['artistid', 'name', map "foo_$_", 0..50],
7282bf38	110	})->first;
	111	is $found->artistid, $new->artistid, 'select with big column list';
	112	is $found->get_column('foo_50'), 'foo', 'last item in big column list';
e38348dd	113
4ffa5700	114	# create a few more rows
8bcd9ece	115	for (1..12) {
4ffa5700	116	$schema->resultset('Artist')->create({ name => 'Artist ' . $_ });
	117	}
	118
	119	# test multiple active cursors
7c5b1b9f	120	my $rs1 = $schema->resultset('Artist')->search({}, { order_by => 'artistid' });
7c5b1b9f	121	my $rs2 = $schema->resultset('Artist')->search({}, { order_by => 'name' });
4ffa5700	122
4ffa5700	123	while ($rs1->next) {
2edf3352	124	ok try { $rs2->next }, 'multiple active cursors';
4ffa5700	125	}
4ffa5700	126
8bcd9ece	127	# test bug where ADO blows up if the first bindparam is shorter than the second
	128	is $schema->resultset('Artist')->search({ artistid => 2 })->first->name,
	129	'Artist 1',
	130	'short bindparam';
	131
	132	is $schema->resultset('Artist')->search({ artistid => 13 })->first->name,
	133	'Artist 12',
	134	'longer bindparam';
	135
2edf3352	136	# test explicit key spec
	137	$new = $ars->create ({ name => 'bar', artistid => 66 });
	138	is($new->artistid, 66, 'Explicit PK worked');
	139	$new->discard_changes;
	140	is($new->artistid, 66, 'Explicit PK assigned');
	141
	142	# test basic transactions
	143	$schema->txn_do(sub {
	144	$ars->create({ name => 'transaction_commit' });
	145	});
	146	ok($ars->search({ name => 'transaction_commit' })->first,
	147	'transaction committed');
	148	$ars->search({ name => 'transaction_commit' })->delete,
	149	throws_ok {
	150	$schema->txn_do(sub {
	151	$ars->create({ name => 'transaction_rollback' });
	152	die 'rolling back';
	153	});
	154	} qr/rolling back/, 'rollback executed';
	155	is $ars->search({ name => 'transaction_rollback' })->first, undef,
	156	'transaction rolled back';
	157
	158	# test two-phase commit and inner transaction rollback from nested transactions
	159	$schema->txn_do(sub {
	160	$ars->create({ name => 'in_outer_transaction' });
	161	$schema->txn_do(sub {
	162	$ars->create({ name => 'in_inner_transaction' });
	163	});
	164	ok($ars->search({ name => 'in_inner_transaction' })->first,
	165	'commit from inner transaction visible in outer transaction');
	166	throws_ok {
	167	$schema->txn_do(sub {
	168	$ars->create({ name => 'in_inner_transaction_rolling_back' });
	169	die 'rolling back inner transaction';
	170	});
	171	} qr/rolling back inner transaction/, 'inner transaction rollback executed';
	172	});
	173	ok($ars->search({ name => 'in_outer_transaction' })->first,
	174	'commit from outer transaction');
	175	ok($ars->search({ name => 'in_inner_transaction' })->first,
	176	'commit from inner transaction');
	177	is $ars->search({ name => 'in_inner_transaction_rolling_back' })->first,
	178	undef,
	179	'rollback from inner transaction';
	180	$ars->search({ name => 'in_outer_transaction' })->delete;
	181	$ars->search({ name => 'in_inner_transaction' })->delete;
	182
	183	# test populate
	184	lives_ok (sub {
	185	my @pop;
	186	for (1..2) {
	187	push @pop, { name => "Artist_$_" };
	188	}
	189	$ars->populate (\@pop);
	190	});
	191
	192	# test populate with explicit key
	193	lives_ok (sub {
	194	my @pop;
	195	for (1..2) {
	196	push @pop, { name => "Artist_expkey_$_", artistid => 100 + $_ };
	197	}
	198	$ars->populate (\@pop);
	199	});
200
201	# count what we did so far
202	is ($ars->count, 18, 'Simple count works');
203
204	# test empty insert
205	my $current_artistid = $ars->search({}, {
206	select => [ { max => 'artistid' } ], as => ['artistid']
207	})->first->artistid;
208
209	my $row;
210	lives_ok { $row = $ars->create({}) }
211	'empty insert works';
212
213	$row->discard_changes;
214
215	is $row->artistid, $current_artistid+1,
216	'empty insert generated correct PK';
217
218	# test that autoinc column still works after empty insert
219	$row = $ars->create({ name => 'after_empty_insert' });
220
221	is $row->artistid, $current_artistid+2,
222	'autoincrement column functional aftear empty insert';
223
224	my $rs = $schema->resultset('VaryingMAX');
225
226	foreach my $size (qw/small large/) {
49eeb48d	227	local $schema->storage->{debug} = 0 if $size eq 'large';
2edf3352	228
	229	my $str = $binstr{$size};
	230	my $row;
	231	lives_ok {
	232	$row = $rs->create({
	233	varchar_max => $str, nvarchar_max => $str, varbinary_max => $str
	234	});
	235	} "created $size VARXXX(MAX) LOBs";
	236
	237	lives_ok {
	238	$row->discard_changes;
	239	} 're-selected just-inserted LOBs';
	240
	241	cmp_ok try { $row->varchar_max }, 'eq', $str, 'VARCHAR(MAX) matches';
	242	cmp_ok try { $row->nvarchar_max }, 'eq', $str, 'NVARCHAR(MAX) matches';
	243	cmp_ok try { $row->varbinary_max }, 'eq', $str, 'VARBINARY(MAX) matches';
2edf3352	244	}
	245
	246	# test regular blobs
	247
	248	try { local $^W = 0; $schema->storage->dbh->do('DROP TABLE bindtype_test') };
	249	$schema->storage->dbh->do(qq[
	250	CREATE TABLE bindtype_test
	251	(
	252	id INT IDENTITY NOT NULL PRIMARY KEY,
	253	bytea INT NULL,
	254	blob IMAGE NULL,
	255	clob TEXT NULL,
	256	a_memo NTEXT NULL
	257	)
	258	],{ RaiseError => 1, PrintError => 1 });
	259
	260	$rs = $schema->resultset('BindType');
	261	my $id = 0;
	262
	263	foreach my $type (qw( blob clob a_memo )) {
	264	foreach my $size (qw( small large )) {
	265	$id++;
	266
	267	lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) }
	268	"inserted $size $type without dying" or next;
	269
	270	my $from_db = eval { $rs->find($id)->$type } \|\| '';
	271	diag $@ if $@;
	272
	273	ok($from_db eq $binstr{$size}, "verified inserted $size $type" )
	274	or do {
	275	my $hexdump = sub {
	276	join '', map sprintf('%02X', ord), split //, shift
	277	};
	278	diag 'Got: ', "\n", substr($hexdump->($from_db),0,255), '...',
	279	substr($hexdump->($from_db),-255);
	280	diag 'Size: ', length($from_db);
	281	diag 'Expected Size: ', length($binstr{$size});
	282	diag 'Expected: ', "\n",
	283	substr($hexdump->($binstr{$size}), 0, 255),
	284	"...", substr($hexdump->($binstr{$size}),-255);
	285	};
	286	}
	287	}
	288	# test IMAGE update
	289	lives_ok {
	290	$rs->search({ id => 0 })->update({ blob => $binstr{small} });
	291	} 'updated IMAGE to small binstr without dying';
	292
	293	lives_ok {
	294	$rs->search({ id => 0 })->update({ blob => $binstr{large} });
	295	} 'updated IMAGE to large binstr without dying';
	296
	297	# test GUIDs
	298	lives_ok {
	299	$row = $schema->resultset('ArtistGUID')->create({ name => 'mtfnpy' })
	300	} 'created a row with a GUID';
	301
	302	ok(
	303	eval { $row->artistid },
	304	'row has GUID PK col populated',
	305	);
	306	diag $@ if $@;
	307
308	my $guid = try { $row->artistid }\|\|'';
309
310	ok(($guid !~ /^{.*?}\z/), 'GUID not enclosed in braces')
311	or diag "GUID is: $guid";
312
313	ok(
314	eval { $row->a_guid },
315	'row has a GUID col with auto_nextval populated',
316	);
317	diag $@ if $@;
318
319	my $row_from_db = $schema->resultset('ArtistGUID')
320	->search({ name => 'mtfnpy' })->first;
321
322	is try { $row_from_db->artistid }, try { $row->artistid },
323	'PK GUID round trip (via ->search->next)';
324
325	is try { $row_from_db->a_guid }, try { $row->a_guid },
326	'NON-PK GUID round trip (via ->search->next)';
327
328	$row_from_db = try { $schema->resultset('ArtistGUID')
329	->find($row->artistid) };
330
331	is try { $row_from_db->artistid }, try { $row->artistid },
332	'PK GUID round trip (via ->find)';
333
334	is try { $row_from_db->a_guid }, try { $row->a_guid },
335	'NON-PK GUID round trip (via ->find)';
336
337	($row_from_db) = $schema->resultset('ArtistGUID')
338	->search({ name => 'mtfnpy' })->all;
339
340	is try { $row_from_db->artistid }, try { $row->artistid },
341	'PK GUID round trip (via ->search->all)';
342
343	is try { $row_from_db->a_guid }, try { $row->a_guid },
344	'NON-PK GUID round trip (via ->search->all)';
345
346	lives_ok {
347	$row = $schema->resultset('ArtistGUID')->create({
348	artistid => '70171270-4822-4450-81DF-921F99BA3C06',
349	name => 'explicit_guid',
350	});
351	} 'created a row with explicit PK GUID';
352
353	is try { $row->artistid }, '70171270-4822-4450-81DF-921F99BA3C06',
354	'row has correct PK GUID';
355
356	lives_ok {
357	$row->update({ artistid => '70171270-4822-4450-81DF-921F99BA3C07' });
358	} "updated row's PK GUID";
359
360	is try { $row->artistid }, '70171270-4822-4450-81DF-921F99BA3C07',
361	'row has correct PK GUID';
362
363	lives_ok {
364	$row->delete;
365	} 'deleted the row';
366
367	lives_ok {
368	$schema->resultset('ArtistGUID')->populate([{
369	artistid => '70171270-4822-4450-81DF-921F99BA3C06',
370	name => 'explicit_guid',
371	}]);
372	} 'created a row with explicit PK GUID via ->populate in void context';
373
8bcd9ece	374	done_testing;
8bcd9ece	375
4ffa5700	376	# clean up our mess
4ffa5700	377	END {
2edf3352	378	local $SIG{__WARN__} = sub {};
	379	if (my $dbh = try { $schema->storage->_dbh }) {
	380	(try { $dbh->do("DROP TABLE $_") })
	381	for qw/artist artist_guid varying_max_test bindtype_test/;
4ffa5700	382	}
65d35121	383
65d35121	384	undef $schema;
4ffa5700	385	}
4ffa5700	386	# vim:sw=2 sts=2