[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;
use DBIC::DebugObj ();
use DBIC::SqlMakerTest;

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 ($sql, @bind);

  my $joined_track = try {
    local $schema->storage->{debug} = 1;
    local $schema->storage->{debugobj} = DBIC::DebugObj->new(\$sql, \@bind);

    $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: $_";
  };

  s/^'//, s/'\z// for @bind;

  # test is duplicated in t/sqlmaker/msaccess.t, keep a duplicate here anyway, just to be safe
  # -- ribasushi
  is_same_sql_bind(
    $sql,
    \@bind,
    'SELECT [me].[artistid], [me].[name], [me].[rank], [me].[charfield], [tracks].[title] FROM ( ( [artist] [me] LEFT JOIN cd [cds] ON [cds].[artist] = [me].[artistid] ) LEFT JOIN [track] [tracks] ON [tracks].[cd] = [cds].[cdid] ) WHERE ( [artistid] = ? )',
    [1],
    'correct SQL for two-step left join',
  );

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

  ($sql, @bind) = ();

  $joined_artist = try {
    local $schema->storage->{debug} = 1;
    local $schema->storage->{debugobj} = DBIC::DebugObj->new(\$sql, \@bind);

    $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: $_";
  };

  s/^'//, s/'\z// for @bind;

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