[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);

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