[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,
  blob2  IMAGE NULL,
  clob   TEXT NULL,
  clob2  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,
74b5397c	255	blob2 IMAGE NULL,
2edf3352	256	clob TEXT NULL,
74b5397c	257	clob2 TEXT NULL,
2edf3352	258	a_memo NTEXT NULL
	259	)
	260	],{ RaiseError => 1, PrintError => 1 });
	261
	262	$rs = $schema->resultset('BindType');
	263	my $id = 0;
	264
	265	foreach my $type (qw( blob clob a_memo )) {
	266	foreach my $size (qw( small large )) {
	267	$id++;
	268
	269	lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) }
	270	"inserted $size $type without dying" or next;
	271
	272	my $from_db = eval { $rs->find($id)->$type } \|\| '';
	273	diag $@ if $@;
	274
	275	ok($from_db eq $binstr{$size}, "verified inserted $size $type" )
	276	or do {
	277	my $hexdump = sub {
	278	join '', map sprintf('%02X', ord), split //, shift
	279	};
	280	diag 'Got: ', "\n", substr($hexdump->($from_db),0,255), '...',
	281	substr($hexdump->($from_db),-255);
	282	diag 'Size: ', length($from_db);
	283	diag 'Expected Size: ', length($binstr{$size});
	284	diag 'Expected: ', "\n",
	285	substr($hexdump->($binstr{$size}), 0, 255),
	286	"...", substr($hexdump->($binstr{$size}),-255);
	287	};
	288	}
	289	}
	290	# test IMAGE update
	291	lives_ok {
	292	$rs->search({ id => 0 })->update({ blob => $binstr{small} });
	293	} 'updated IMAGE to small binstr without dying';
	294
	295	lives_ok {
	296	$rs->search({ id => 0 })->update({ blob => $binstr{large} });
	297	} 'updated IMAGE to large binstr without dying';
	298
	299	# test GUIDs
	300	lives_ok {
	301	$row = $schema->resultset('ArtistGUID')->create({ name => 'mtfnpy' })
	302	} 'created a row with a GUID';
	303
	304	ok(
	305	eval { $row->artistid },
	306	'row has GUID PK col populated',
	307	);
	308	diag $@ if $@;
	309
	310	my $guid = try { $row->artistid }\|\|'';
	311
	312	ok(($guid !~ /^{.*?}\z/), 'GUID not enclosed in braces')
	313	or diag "GUID is: $guid";
	314
	315	ok(
	316	eval { $row->a_guid },
	317	'row has a GUID col with auto_nextval populated',
	318	);
	319	diag $@ if $@;
	320
	321	my $row_from_db = $schema->resultset('ArtistGUID')
322	->search({ name => 'mtfnpy' })->first;
323
324	is try { $row_from_db->artistid }, try { $row->artistid },
325	'PK GUID round trip (via ->search->next)';
326
327	is try { $row_from_db->a_guid }, try { $row->a_guid },
328	'NON-PK GUID round trip (via ->search->next)';
329
330	$row_from_db = try { $schema->resultset('ArtistGUID')
331	->find($row->artistid) };
332
333	is try { $row_from_db->artistid }, try { $row->artistid },
334	'PK GUID round trip (via ->find)';
335
336	is try { $row_from_db->a_guid }, try { $row->a_guid },
337	'NON-PK GUID round trip (via ->find)';
338
339	($row_from_db) = $schema->resultset('ArtistGUID')
340	->search({ name => 'mtfnpy' })->all;
341
342	is try { $row_from_db->artistid }, try { $row->artistid },
343	'PK GUID round trip (via ->search->all)';
344
345	is try { $row_from_db->a_guid }, try { $row->a_guid },
346	'NON-PK GUID round trip (via ->search->all)';
347
348	lives_ok {
349	$row = $schema->resultset('ArtistGUID')->create({
350	artistid => '70171270-4822-4450-81DF-921F99BA3C06',
351	name => 'explicit_guid',
352	});
353	} 'created a row with explicit PK GUID';
354
355	is try { $row->artistid }, '70171270-4822-4450-81DF-921F99BA3C06',
356	'row has correct PK GUID';
357
358	lives_ok {
359	$row->update({ artistid => '70171270-4822-4450-81DF-921F99BA3C07' });
360	} "updated row's PK GUID";
361
362	is try { $row->artistid }, '70171270-4822-4450-81DF-921F99BA3C07',
363	'row has correct PK GUID';
364
365	lives_ok {
366	$row->delete;
367	} 'deleted the row';
368
369	lives_ok {
370	$schema->resultset('ArtistGUID')->populate([{
371	artistid => '70171270-4822-4450-81DF-921F99BA3C06',
372	name => 'explicit_guid',
373	}]);
374	} 'created a row with explicit PK GUID via ->populate in void context';
375
8bcd9ece	376	done_testing;
8bcd9ece	377
4ffa5700	378	# clean up our mess
4ffa5700	379	END {
2edf3352	380	local $SIG{__WARN__} = sub {};
	381	if (my $dbh = try { $schema->storage->_dbh }) {
	382	(try { $dbh->do("DROP TABLE $_") })
	383	for qw/artist artist_guid varying_max_test bindtype_test/;
4ffa5700	384	}
65d35121	385
65d35121	386	undef $schema;
4ffa5700	387	}
4ffa5700	388	# vim:sw=2 sts=2