[dbsrgits/DBIx-Class.git] / t / 751msaccess.t

use strict;
use warnings;

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

my ($dsn,  $user,  $pass)  = @ENV{map { "DBICTEST_MSACCESS_ODBC_${_}" } qw/DSN USER PASS/};
my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_MSACCESS_ADO_${_}" }  qw/DSN USER PASS/};

plan skip_all => 'Test needs ' .
  (join ' or ', map { $_ ? $_ : () }
    DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_msaccess_odbc'),
    DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_msaccess_ado'))
  unless
    $dsn && DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_msaccess_odbc')
    or
    $dsn2 && DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_msaccess_ado')
    or
    (not $dsn || $dsn2);

require DBICTest::Schema;
DBICTest::Schema->load_classes('ArtistGUID');

# Example DSNs (32bit only):
# dbi:ODBC:driver={Microsoft Access Driver (*.mdb, *.accdb)};dbq=C:\Users\rkitover\Documents\access_sample.accdb
# dbi:ADO:Microsoft.Jet.OLEDB.4.0;Data Source=C:\Users\rkitover\Documents\access_sample.accdb
# dbi:ADO:Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\rkitover\Documents\access_sample.accdb;Persist Security Info=False'

plan skip_all => <<'EOF' unless $dsn || $dsn2;
Set $ENV{DBICTEST_MSACCESS_ODBC_DSN} and/or $ENV{DBICTEST_MSACCESS_ADO_DSN} (and optionally _USER and _PASS) to run these tests.
Warning: this test drops and creates the tables 'artist', 'cd', 'bindtype_test' and 'artist_guid'.
EOF

my @info = (
  [ $dsn,  $user  || '', $pass  || '' ],
  [ $dsn2, $user2 || '', $pass2 || '' ],
);

foreach my $info (@info) {
  my ($dsn, $user, $pass) = @$info;

  next unless $dsn;

# Check that we can connect without any options.
  my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
  lives_ok {
    $schema->storage->ensure_connected;
  } 'connection without any options';

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

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

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

  my $guard = Scope::Guard->new(sub { cleanup($schema) });

  my $dbh = $schema->storage->dbh;

  # turn off warnings for OLE exception from ADO about nonexistant table
  eval { local $^W = 0; $dbh->do("DROP TABLE artist") };

  $dbh->do(<<EOF);
  CREATE TABLE artist (
    artistid AUTOINCREMENT PRIMARY KEY,
    name VARCHAR(255) NULL,
    charfield CHAR(10) NULL,
    rank INT NULL
  )
EOF

  my $ars = $schema->resultset('Artist');
  is ( $ars->count, 0, 'No rows at first' );

# test primary key handling
  my $new = $ars->create({ name => 'foo' });
  ok($new->artistid, "Auto-PK worked");

  my $first_artistid = $new->artistid;

# 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 joins
  eval { local $^W = 0; $dbh->do("DROP TABLE cd") };

  $dbh->do(<<EOF);
  CREATE TABLE cd (
    cdid AUTOINCREMENT PRIMARY KEY,
    artist INTEGER NULL,
    title VARCHAR(255) NULL,
    [year] CHAR(4) NULL,
    genreid INTEGER NULL,
    single_track INTEGER NULL
  )
EOF

  $dbh->do(<<EOF);
  CREATE TABLE track (
    trackid AUTOINCREMENT PRIMARY KEY,
    cd INTEGER REFERENCES cd(cdid),
    [position] INTEGER,
    title VARCHAR(255),
    last_updated_on DATETIME,
    last_updated_at DATETIME
  )
EOF

  my $cd = $schema->resultset('CD')->create({
    artist => $first_artistid,
    title => 'Some Album',
  });

# one-step join
  my $joined_artist = $schema->resultset('Artist')->search({
    artistid => $first_artistid,
  }, {
    join => [ 'cds' ],
    '+select' => [ 'cds.title' ],
    '+as'     => [ 'cd_title'  ],
  })->next;

  is $joined_artist->get_column('cd_title'), 'Some Album',
    'one-step join works';

# two-step join
  my $track = $schema->resultset('Track')->create({
    cd => $cd->cdid,
    position => 1,
    title => 'my track',
  });

  my $joined_track = try {
    $schema->resultset('Artist')->search({
      artistid => $first_artistid,
    }, {
      join => [{ cds => 'tracks' }],
      '+select' => [ 'tracks.title' ],
      '+as'     => [ 'track_title'  ],
    })->next;
  }
  catch {
    diag "Could not execute two-step left join: $_";
  };

  is try { $joined_track->get_column('track_title') }, 'my track',
    'two-step left join works';

  $joined_artist = try {
    $schema->resultset('Track')->search({
      trackid => $track->trackid,
    }, {
      join => [{ cd => 'artist' }],
      '+select' => [ 'artist.name' ],
      '+as'     => [ 'artist_name'  ],
    })->next;
  }
  catch {
    diag "Could not execute two-step inner join: $_";
  };

  is try { $joined_artist->get_column('artist_name') }, 'foo',
    'two-step inner join works';

# 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, 6, 'Simple count works');

# test LIMIT support
# not testing offset because access only supports TOP
  my $lim = $ars->search( {},
    {
      rows => 2,
      offset => 0,
      order_by => 'artistid'
    }
  );
  is( $lim->count, 2, 'ROWS+OFFSET count ok' );
  is( $lim->all, 2, 'Number of ->all objects matches count' );

# test iterator
  $lim->reset;
  is( $lim->next->artistid, 1, "iterator->next ok" );
  is( $lim->next->artistid, 66, "iterator->next ok" );
  is( $lim->next, undef, "next past end of resultset ok" );

# 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';

# test blobs (stolen from 73oracle.t)

# turn off horrendous binary DBIC_TRACE output
  {
    local $schema->storage->{debug} = 0;

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

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

    foreach my $type (qw( blob clob a_memo )) {
      foreach my $size (qw( small large )) {
        SKIP: {
          skip 'TEXT columns not cast to MEMO over ODBC', 2
            if $type eq 'clob' && $size eq 'large' && $dsn =~ /:ODBC:/;

          $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 (and the cursor GUID fixup stuff for ADO)

  require Data::GUID;
  $schema->storage->new_guid(sub { Data::GUID->new->as_string });

  local $schema->source('ArtistGUID')->column_info('artistid')->{data_type}
    = 'guid';

  local $schema->source('ArtistGUID')->column_info('a_guid')->{data_type}
    = 'guid';

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

  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 (via ->search->next)';

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

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

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

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

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

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

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

done_testing;

sub cleanup {
  my $schema = shift;

  if (my $storage = eval { $schema->storage }) {
    # cannot drop a table if it has been used, have to reconnect first
    $schema->storage->disconnect;
    local $^W = 0; # for ADO OLE exceptions
    $schema->storage->dbh->do("DROP TABLE $_")
      for qw/artist track cd bindtype_test artist_guid/;
  }
}

# vim:sts=2 sw=2:
Commit	Line	Data
726c8f65	1	use strict;
	2	use warnings;
	3
	4	use Test::More;
	5	use Test::Exception;
	6	use Scope::Guard ();
	7	use Try::Tiny;
199fbc45	8	use DBIx::Class::Optional::Dependencies ();
726c8f65	9	use lib qw(t/lib);
	10	use DBICTest;
	11
199fbc45	12	my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSACCESS_ODBC_${_}" } qw/DSN USER PASS/};
	13	my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_MSACCESS_ADO_${_}" } qw/DSN USER PASS/};
	14
	15	plan skip_all => 'Test needs ' .
	16	(join ' or ', map { $_ ? $_ : () }
	17	DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_msaccess_odbc'),
	18	DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_msaccess_ado'))
	19	unless
	20	$dsn && DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_msaccess_odbc')
	21	or
	22	$dsn2 && DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_msaccess_ado')
	23	or
	24	(not $dsn \|\| $dsn2);
	25
2c2bc4e5	26	require DBICTest::Schema;
726c8f65	27	DBICTest::Schema->load_classes('ArtistGUID');
	28
	29	# Example DSNs (32bit only):
	30	# dbi:ODBC:driver={Microsoft Access Driver (.mdb, .accdb)};dbq=C:\Users\rkitover\Documents\access_sample.accdb
	31	# dbi:ADO:Microsoft.Jet.OLEDB.4.0;Data Source=C:\Users\rkitover\Documents\access_sample.accdb
	32	# dbi:ADO:Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\rkitover\Documents\access_sample.accdb;Persist Security Info=False'
	33
726c8f65	34	plan skip_all => <<'EOF' unless $dsn \|\| $dsn2;
076bd599	35	Set $ENV{DBICTEST_MSACCESS_ODBC_DSN} and/or $ENV{DBICTEST_MSACCESS_ADO_DSN} (and optionally _USER and _PASS) to run these tests.
076bd599	36	Warning: this test drops and creates the tables 'artist', 'cd', 'bindtype_test' and 'artist_guid'.
726c8f65	37	EOF
726c8f65	38
726c8f65	39	my @info = (
	40	[ $dsn, $user \|\| '', $pass \|\| '' ],
	41	[ $dsn2, $user2 \|\| '', $pass2 \|\| '' ],
	42	);
	43
726c8f65	44	foreach my $info (@info) {
	45	my ($dsn, $user, $pass) = @$info;
	46
	47	next unless $dsn;
	48
	49	# Check that we can connect without any options.
2d48959a	50	my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
726c8f65	51	lives_ok {
	52	$schema->storage->ensure_connected;
	53	} 'connection without any options';
	54
	55	my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) );
	56	$binstr{'large'} = $binstr{'small'} x 1024;
	57
	58	my $maxloblen = length $binstr{'large'};
	59
	60	$schema = DBICTest::Schema->connect($dsn, $user, $pass, {
	61	quote_names => 1,
	62	auto_savepoint => 1,
	63	LongReadLen => $maxloblen,
	64	});
	65
2d48959a	66	my $guard = Scope::Guard->new(sub { cleanup($schema) });
726c8f65	67
	68	my $dbh = $schema->storage->dbh;
	69
	70	# turn off warnings for OLE exception from ADO about nonexistant table
	71	eval { local $^W = 0; $dbh->do("DROP TABLE artist") };
	72
	73	$dbh->do(<<EOF);
	74	CREATE TABLE artist (
	75	artistid AUTOINCREMENT PRIMARY KEY,
	76	name VARCHAR(255) NULL,
	77	charfield CHAR(10) NULL,
	78	rank INT NULL
	79	)
	80	EOF
	81
	82	my $ars = $schema->resultset('Artist');
	83	is ( $ars->count, 0, 'No rows at first' );
	84
	85	# test primary key handling
	86	my $new = $ars->create({ name => 'foo' });
	87	ok($new->artistid, "Auto-PK worked");
	88
	89	my $first_artistid = $new->artistid;
	90
	91	# test explicit key spec
	92	$new = $ars->create ({ name => 'bar', artistid => 66 });
	93	is($new->artistid, 66, 'Explicit PK worked');
	94	$new->discard_changes;
	95	is($new->artistid, 66, 'Explicit PK assigned');
	96
	97	# test joins
	98	eval { local $^W = 0; $dbh->do("DROP TABLE cd") };
	99
	100	$dbh->do(<<EOF);
	101	CREATE TABLE cd (
	102	cdid AUTOINCREMENT PRIMARY KEY,
	103	artist INTEGER NULL,
	104	title VARCHAR(255) NULL,
	105	[year] CHAR(4) NULL,
	106	genreid INTEGER NULL,
	107	single_track INTEGER NULL
	108	)
	109	EOF
	110
	111	$dbh->do(<<EOF);
	112	CREATE TABLE track (
	113	trackid AUTOINCREMENT PRIMARY KEY,
	114	cd INTEGER REFERENCES cd(cdid),
	115	[position] INTEGER,
	116	title VARCHAR(255),
	117	last_updated_on DATETIME,
	118	last_updated_at DATETIME
	119	)
	120	EOF
	121
	122	my $cd = $schema->resultset('CD')->create({
	123	artist => $first_artistid,
	124	title => 'Some Album',
	125	});
	126
	127	# one-step join
	128	my $joined_artist = $schema->resultset('Artist')->search({
	129	artistid => $first_artistid,
	130	}, {
131	join => [ 'cds' ],
132	'+select' => [ 'cds.title' ],
133	'+as' => [ 'cd_title' ],
134	})->next;
135
136	is $joined_artist->get_column('cd_title'), 'Some Album',
137	'one-step join works';
138
139	# two-step join
140	my $track = $schema->resultset('Track')->create({
141	cd => $cd->cdid,
142	position => 1,
143	title => 'my track',
144	});
145
146	my $joined_track = try {
147	$schema->resultset('Artist')->search({
148	artistid => $first_artistid,
149	}, {
150	join => [{ cds => 'tracks' }],
151	'+select' => [ 'tracks.title' ],
152	'+as' => [ 'track_title' ],
153	})->next;
154	}
155	catch {
696ba760	156	diag "Could not execute two-step left join: $_";
726c8f65	157	};
	158
	159	is try { $joined_track->get_column('track_title') }, 'my track',
696ba760	160	'two-step left join works';
696ba760	161
696ba760	162	$joined_artist = try {
696ba760	163	$schema->resultset('Track')->search({
	164	trackid => $track->trackid,
	165	}, {
	166	join => [{ cd => 'artist' }],
	167	'+select' => [ 'artist.name' ],
	168	'+as' => [ 'artist_name' ],
	169	})->next;
	170	}
	171	catch {
	172	diag "Could not execute two-step inner join: $_";
	173	};
	174
696ba760	175	is try { $joined_artist->get_column('artist_name') }, 'foo',
696ba760	176	'two-step inner join works';
726c8f65	177
	178	# test basic transactions
	179	$schema->txn_do(sub {
	180	$ars->create({ name => 'transaction_commit' });
	181	});
	182	ok($ars->search({ name => 'transaction_commit' })->first,
	183	'transaction committed');
	184	$ars->search({ name => 'transaction_commit' })->delete,
	185	throws_ok {
	186	$schema->txn_do(sub {
	187	$ars->create({ name => 'transaction_rollback' });
	188	die 'rolling back';
	189	});
	190	} qr/rolling back/, 'rollback executed';
	191	is $ars->search({ name => 'transaction_rollback' })->first, undef,
	192	'transaction rolled back';
	193
	194	# test two-phase commit and inner transaction rollback from nested transactions
	195	$schema->txn_do(sub {
	196	$ars->create({ name => 'in_outer_transaction' });
	197	$schema->txn_do(sub {
	198	$ars->create({ name => 'in_inner_transaction' });
	199	});
	200	ok($ars->search({ name => 'in_inner_transaction' })->first,
	201	'commit from inner transaction visible in outer transaction');
	202	throws_ok {
	203	$schema->txn_do(sub {
	204	$ars->create({ name => 'in_inner_transaction_rolling_back' });
	205	die 'rolling back inner transaction';
	206	});
	207	} qr/rolling back inner transaction/, 'inner transaction rollback executed';
	208	});
	209	ok($ars->search({ name => 'in_outer_transaction' })->first,
	210	'commit from outer transaction');
	211	ok($ars->search({ name => 'in_inner_transaction' })->first,
	212	'commit from inner transaction');
	213	is $ars->search({ name => 'in_inner_transaction_rolling_back' })->first,
	214	undef,
	215	'rollback from inner transaction';
	216	$ars->search({ name => 'in_outer_transaction' })->delete;
	217	$ars->search({ name => 'in_inner_transaction' })->delete;
	218
	219	# test populate
	220	lives_ok (sub {
	221	my @pop;
	222	for (1..2) {
	223	push @pop, { name => "Artist_$_" };
	224	}
	225	$ars->populate (\@pop);
	226	});
	227
	228	# test populate with explicit key
	229	lives_ok (sub {
	230	my @pop;
	231	for (1..2) {
	232	push @pop, { name => "Artist_expkey_$_", artistid => 100 + $_ };
	233	}
	234	$ars->populate (\@pop);
	235	});
	236
	237	# count what we did so far
	238	is ($ars->count, 6, 'Simple count works');
	239
	240	# test LIMIT support
241	# not testing offset because access only supports TOP
242	my $lim = $ars->search( {},
243	{
244	rows => 2,
245	offset => 0,
246	order_by => 'artistid'
247	}
248	);
249	is( $lim->count, 2, 'ROWS+OFFSET count ok' );
250	is( $lim->all, 2, 'Number of ->all objects matches count' );
251
252	# test iterator
253	$lim->reset;
254	is( $lim->next->artistid, 1, "iterator->next ok" );
255	is( $lim->next->artistid, 66, "iterator->next ok" );
256	is( $lim->next, undef, "next past end of resultset ok" );
257
258	# test empty insert
259	my $current_artistid = $ars->search({}, {
260	select => [ { max => 'artistid' } ], as => ['artistid']
261	})->first->artistid;
262
263	my $row;
264	lives_ok { $row = $ars->create({}) }
265	'empty insert works';
266
267	$row->discard_changes;
268
269	is $row->artistid, $current_artistid+1,
270	'empty insert generated correct PK';
271
272	# test that autoinc column still works after empty insert
273	$row = $ars->create({ name => 'after_empty_insert' });
274
275	is $row->artistid, $current_artistid+2,
276	'autoincrement column functional aftear empty insert';
277
278	# test blobs (stolen from 73oracle.t)
279
280	# turn off horrendous binary DBIC_TRACE output
281	{
282	local $schema->storage->{debug} = 0;
283
284	eval { local $^W = 0; $dbh->do('DROP TABLE bindtype_test') };
285	$dbh->do(qq[
286	CREATE TABLE bindtype_test
287	(
288	id INT NOT NULL PRIMARY KEY,
289	bytea INT NULL,
290	blob IMAGE NULL,
74b5397c	291	blob2 IMAGE NULL,
726c8f65	292	clob TEXT NULL,
74b5397c	293	clob2 TEXT NULL,
726c8f65	294	a_memo MEMO NULL
	295	)
	296	],{ RaiseError => 1, PrintError => 1 });
	297
	298	my $rs = $schema->resultset('BindType');
	299	my $id = 0;
	300
	301	foreach my $type (qw( blob clob a_memo )) {
	302	foreach my $size (qw( small large )) {
	303	SKIP: {
	304	skip 'TEXT columns not cast to MEMO over ODBC', 2
	305	if $type eq 'clob' && $size eq 'large' && $dsn =~ /:ODBC:/;
	306
	307	$id++;
	308
	309	lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) }
	310	"inserted $size $type without dying" or next;
	311
	312	my $from_db = eval { $rs->find($id)->$type } \|\| '';
	313	diag $@ if $@;
	314
	315	ok($from_db eq $binstr{$size}, "verified inserted $size $type" )
	316	or do {
	317	my $hexdump = sub {
	318	join '', map sprintf('%02X', ord), split //, shift
	319	};
	320	diag 'Got: ', "\n", substr($hexdump->($from_db),0,255), '...',
	321	substr($hexdump->($from_db),-255);
	322	diag 'Size: ', length($from_db);
	323	diag 'Expected Size: ', length($binstr{$size});
	324	diag 'Expected: ', "\n",
	325	substr($hexdump->($binstr{$size}), 0, 255),
	326	"...", substr($hexdump->($binstr{$size}),-255);
	327	};
	328	}
	329	}
	330	}
	331	# test IMAGE update
	332	lives_ok {
	333	$rs->search({ id => 0 })->update({ blob => $binstr{small} });
	334	} 'updated IMAGE to small binstr without dying';
	335
	336	lives_ok {
	337	$rs->search({ id => 0 })->update({ blob => $binstr{large} });
	338	} 'updated IMAGE to large binstr without dying';
	339	}
	340
	341	# test GUIDs (and the cursor GUID fixup stuff for ADO)
	342
	343	require Data::GUID;
	344	$schema->storage->new_guid(sub { Data::GUID->new->as_string });
	345
	346	local $schema->source('ArtistGUID')->column_info('artistid')->{data_type}
	347	= 'guid';
	348
	349	local $schema->source('ArtistGUID')->column_info('a_guid')->{data_type}
	350	= 'guid';
	351
	352	$schema->storage->dbh_do (sub {
	353	my ($storage, $dbh) = @_;
	354	eval { local $^W = 0; $dbh->do("DROP TABLE artist_guid") };
	355	$dbh->do(<<"SQL");
	356	CREATE TABLE artist_guid (
	357	artistid GUID NOT NULL,
358	name VARCHAR(100),
359	rank INT NULL,
360	charfield CHAR(10) NULL,
361	a_guid GUID,
362	primary key(artistid)
363	)
364	SQL
365	});
366
367	lives_ok {
368	$row = $schema->resultset('ArtistGUID')->create({ name => 'mtfnpy' })
369	} 'created a row with a GUID';
370
371	ok(
372	eval { $row->artistid },
373	'row has GUID PK col populated',
374	);
375	diag $@ if $@;
376
377	ok(
378	eval { $row->a_guid },
379	'row has a GUID col with auto_nextval populated',
380	);
381	diag $@ if $@;
382
383	my $row_from_db = $schema->resultset('ArtistGUID')
384	->search({ name => 'mtfnpy' })->first;
385
386	is $row_from_db->artistid, $row->artistid,
387	'PK GUID round trip (via ->search->next)';
388
389	is $row_from_db->a_guid, $row->a_guid,
390	'NON-PK GUID round trip (via ->search->next)';
391
392	$row_from_db = $schema->resultset('ArtistGUID')
393	->find($row->artistid);
394
395	is $row_from_db->artistid, $row->artistid,
396	'PK GUID round trip (via ->find)';
397
398	is $row_from_db->a_guid, $row->a_guid,
399	'NON-PK GUID round trip (via ->find)';
400
401	($row_from_db) = $schema->resultset('ArtistGUID')
402	->search({ name => 'mtfnpy' })->all;
403
404	is $row_from_db->artistid, $row->artistid,
405	'PK GUID round trip (via ->search->all)';
406
407	is $row_from_db->a_guid, $row->a_guid,
408	'NON-PK GUID round trip (via ->search->all)';
409	}
410
411	done_testing;
412
413	sub cleanup {
2d48959a	414	my $schema = shift;
2d48959a	415
726c8f65	416	if (my $storage = eval { $schema->storage }) {
	417	# cannot drop a table if it has been used, have to reconnect first
	418	$schema->storage->disconnect;
	419	local $^W = 0; # for ADO OLE exceptions
	420	$schema->storage->dbh->do("DROP TABLE $_")
	421	for qw/artist track cd bindtype_test artist_guid/;
	422	}
	423	}
	424
	425	# vim:sts=2 sw=2: