use strict;
+use warnings;
+
use Test::More;
use IO::File;
eval "use DBD::SQLite";
plan $@
? ( skip_all => 'needs DBD::SQLite for testing' )
- : ( tests => 7 );
+ : ( tests => 6 );
}
use lib qw(t/lib);
use_ok('DBICTest');
-
-use_ok('DBICTest::HelperRels');
+DBICTest::init_schema();
DBICTest->schema->storage->sql_maker->quote_char("'");
DBICTest->schema->storage->sql_maker->name_sep('.');
eval "use DBD::SQLite";
plan $@
? ( skip_all => 'needs DBD::SQLite for testing' )
- : ( tests => 13 );
+ : ( tests => 12 );
}
use lib qw(t/lib);
use_ok('DBICTest');
-use_ok('DBICTest::HelperRels');
+DBICTest::init_schema();
my $cbworks = 0;
use warnings;
use lib qw(t/lib);
use DBICTest;
-use DBICTest::BasicRels;
plan tests => 7;
-my $schema = DBICTest->schema;
+my $schema = DBICTest->init_schema();
my $total_cds = $schema->resultset('CD')->count;
cmp_ok($total_cds, '>', 0, 'need cd records');
ok($artist2->delete_related('cds', {title => {like => '%'}}));
cmp_ok($schema->resultset('CD')->count, '==', ($total_cds - $artist2_cds), 'too many cds were deleted');
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest->init_schema();
+
+plan tests => 60;
+
+# figure out if we've got a version of sqlite that is older than 3.2.6, in
+# which case COUNT(DISTINCT()) doesn't work
+my $is_broken_sqlite = 0;
+my ($sqlite_major_ver,$sqlite_minor_ver,$sqlite_patch_ver) =
+ split /\./, $schema->storage->dbh->get_info(18);
+if( $schema->storage->dbh->get_info(17) eq 'SQLite' &&
+ ( ($sqlite_major_ver < 3) ||
+ ($sqlite_major_ver == 3 && $sqlite_minor_ver < 2) ||
+ ($sqlite_major_ver == 3 && $sqlite_minor_ver == 2 && $sqlite_patch_ver < 6) ) ) {
+ $is_broken_sqlite = 1;
+}
+
+
+my @art = $schema->resultset("Artist")->search({ }, { order_by => 'name DESC'});
+
+cmp_ok(@art, '==', 3, "Three artists returned");
+
+my $art = $art[0];
+
+is($art->name, 'We Are Goth', "Correct order too");
+
+$art->name('We Are In Rehab');
+
+is($art->name, 'We Are In Rehab', "Accessor update ok");
+
+is($art->get_column("name"), 'We Are In Rehab', 'And via get_column');
+
+ok($art->update, 'Update run');
+
+my $record_jp = $schema->resultset("Artist")->search(undef, { join => 'cds' })->search(undef, { prefetch => 'cds' })->next;
+
+ok($record_jp, "prefetch on same rel okay");
+
+my $record_fn = $schema->resultset("Artist")->search(undef, { join => 'cds' })->search({'cds.cdid' => '1'}, {join => 'artist_undirected_maps'})->next;
+
+ok($record_fn, "funny join is okay");
+
+@art = $schema->resultset("Artist")->search({ name => 'We Are In Rehab' });
+
+cmp_ok(@art, '==', 1, "Changed artist returned by search");
+
+cmp_ok($art[0]->artistid, '==', 3,'Correct artist too');
+
+$art->delete;
+
+@art = $schema->resultset("Artist")->search({ });
+
+cmp_ok(@art, '==', 2, 'And then there were two');
+
+ok(!$art->in_storage, "It knows it's dead");
+
+eval { $art->delete; };
+
+ok($@, "Can't delete twice: $@");
+
+is($art->name, 'We Are In Rehab', 'But the object is still live');
+
+$art->insert;
+
+ok($art->in_storage, "Re-created");
+
+@art = $schema->resultset("Artist")->search({ });
+
+cmp_ok(@art, '==', 3, 'And now there are three again');
+
+my $new = $schema->resultset("Artist")->create({ artistid => 4 });
+
+cmp_ok($new->artistid, '==', 4, 'Create produced record ok');
+
+@art = $schema->resultset("Artist")->search({ });
+
+cmp_ok(@art, '==', 4, "Oh my god! There's four of them!");
+
+$new->set_column('name' => 'Man With A Fork');
+
+is($new->name, 'Man With A Fork', 'set_column ok');
+
+$new->discard_changes;
+
+ok(!defined $new->name, 'Discard ok');
+
+$new->name('Man With A Spoon');
+
+$new->update;
+
+my $new_again = $schema->resultset("Artist")->find(4);
+
+is($new_again->name, 'Man With A Spoon', 'Retrieved correctly');
+
+is($new_again->ID, 'DBICTest::Artist|artist|artistid=4', 'unique object id generated correctly');
+
+# Test backwards compatibility
+{
+ my $artist_by_hash = $schema->resultset('Artist')->find(artistid => 4);
+ is($artist_by_hash->name, 'Man With A Spoon', 'Retrieved correctly');
+ is($artist_by_hash->ID, 'DBICTest::Artist|artist|artistid=4', 'unique object id generated correctly');
+}
+
+is($schema->resultset("Artist")->count, 4, 'count ok');
+
+# test find_or_new
+{
+ my $existing_obj = $schema->resultset('Artist')->find_or_new({
+ artistid => 4,
+ });
+
+ is($existing_obj->name, 'Man With A Spoon', 'find_or_new: found existing artist');
+ ok($existing_obj->in_storage, 'existing artist is in storage');
+
+ my $new_obj = $schema->resultset('Artist')->find_or_new({
+ artistid => 5,
+ name => 'find_or_new',
+ });
+
+ is($new_obj->name, 'find_or_new', 'find_or_new: instantiated a new artist');
+ ok(! $new_obj->in_storage, 'new artist is not in storage');
+}
+
+my $cd = $schema->resultset("CD")->find(1);
+my %cols = $cd->get_columns;
+
+cmp_ok(keys %cols, '==', 4, 'get_columns number of columns ok');
+
+is($cols{title}, 'Spoonful of bees', 'get_columns values ok');
+
+%cols = ( title => 'Forkful of bees', year => 2005);
+$cd->set_columns(\%cols);
+
+is($cd->title, 'Forkful of bees', 'set_columns ok');
+
+is($cd->year, 2005, 'set_columns ok');
+
+$cd->discard_changes;
+
+# check whether ResultSource->columns returns columns in order originally supplied
+my @cd = $schema->source("CD")->columns;
+
+is_deeply( \@cd, [qw/cdid artist title year/], 'column order');
+
+$cd = $schema->resultset("CD")->search({ title => 'Spoonful of bees' }, { columns => ['title'] })->next;
+is($cd->title, 'Spoonful of bees', 'subset of columns returned correctly');
+
+$cd = $schema->resultset("CD")->search(undef, { include_columns => [ 'artist.name' ], join => [ 'artist' ] })->find(1);
+
+is($cd->title, 'Spoonful of bees', 'Correct CD returned with include');
+is($cd->get_column('name'), 'Caterwauler McCrae', 'Additional column returned');
+
+# update_or_insert
+$new = $schema->resultset("Track")->new( {
+ trackid => 100,
+ cd => 1,
+ position => 1,
+ title => 'Insert or Update',
+} );
+$new->update_or_insert;
+ok($new->in_storage, 'update_or_insert insert ok');
+
+# test in update mode
+$new->pos(5);
+$new->update_or_insert;
+is( $schema->resultset("Track")->find(100)->pos, 5, 'update_or_insert update ok');
+
+eval { $schema->class("Track")->load_components('DoesNotExist'); };
+
+ok $@, $@;
+
+is($schema->class("Artist")->field_name_for->{name}, 'artist name', 'mk_classdata usage ok');
+
+my $search = [ { 'tags.tag' => 'Cheesy' }, { 'tags.tag' => 'Blue' } ];
+
+my( $or_rs ) = $schema->resultset("CD")->search_rs($search, { join => 'tags',
+ order_by => 'cdid' });
+
+cmp_ok($or_rs->count, '==', 5, 'Search with OR ok');
+
+my $distinct_rs = $schema->resultset("CD")->search($search, { join => 'tags', distinct => 1 });
+cmp_ok($distinct_rs->all, '==', 4, 'DISTINCT search with OR ok');
+
+SKIP: {
+ skip "SQLite < 3.2.6 doesn't understand COUNT(DISTINCT())", 1
+ if $is_broken_sqlite;
+
+ my $tcount = $schema->resultset("Track")->search(
+ {},
+ {
+ select => {count => {distinct => ['position', 'title']}},
+ as => ['count']
+ }
+ );
+ cmp_ok($tcount->next->get_column('count'), '==', 13, 'multiple column COUNT DISTINCT ok');
+
+}
+my $tag_rs = $schema->resultset('Tag')->search(
+ [ { 'me.tag' => 'Cheesy' }, { 'me.tag' => 'Blue' } ]);
+
+my $rel_rs = $tag_rs->search_related('cd');
+
+cmp_ok($rel_rs->count, '==', 5, 'Related search ok');
+
+cmp_ok($or_rs->next->cdid, '==', $rel_rs->next->cdid, 'Related object ok');
+$or_rs->reset;
+$rel_rs->reset;
+
+my $tag = $schema->resultset('Tag')->search(
+ [ { 'me.tag' => 'Blue' } ], { cols=>[qw/tagid/] } )->next;
+
+cmp_ok($tag->has_column_loaded('tagid'), '==', 1, 'Has tagid loaded');
+cmp_ok($tag->has_column_loaded('tag'), '==', 0, 'Has not tag loaded');
+
+ok($schema->storage(), 'Storage available');
+
+{
+ my $rs = $schema->resultset("Artist")->search({
+ -and => [
+ artistid => { '>=', 1 },
+ artistid => { '<', 3 }
+ ]
+ });
+
+ $rs->update({ name => 'Test _cond_for_update_delete' });
+
+ my $art;
+
+ $art = $schema->resultset("Artist")->find(1);
+ is($art->name, 'Test _cond_for_update_delete', 'updated first artist name');
+
+ $art = $schema->resultset("Artist")->find(2);
+ is($art->name, 'Test _cond_for_update_delete', 'updated second artist name');
+}
+
+# test source_name
+{
+ # source_name should be set for normal modules
+ is($schema->source('CD')->source_name, 'CD', 'source_name is set to moniker');
+
+ # test the result source that sets source_name explictly
+ ok($schema->source('SourceNameArtists'), 'SourceNameArtists result source exists');
+
+ my @artsn = $schema->resultset('SourceNameArtists')->search({}, { order_by => 'name DESC' });
+ cmp_ok(@artsn, '==', 4, "Four artists returned");
+}
+
+my $newbook = $schema->resultset( 'Bookmark' )->find(1);
+
+$@ = '';
+eval {
+my $newlink = $newbook->link;
+};
+ok(!$@, "stringify to false value doesn't cause error");
+
+# test cascade_delete through many_to_many relations
+{
+ my $art_del = $schema->resultset("Artist")->find({ artistid => 1 });
+ $art_del->delete;
+ cmp_ok( $schema->resultset("CD")->search({artist => 1}), '==', 0, 'Cascading through has_many top level.');
+ cmp_ok( $schema->resultset("CD_to_Producer")->search({cd => 1}), '==', 0, 'Cascading through has_many children.');
+}
+
+# test column_info
+{
+ $schema->source("Artist")->{_columns}{'artistid'} = {};
+
+ my $typeinfo = $schema->source("Artist")->column_info('artistid');
+ is($typeinfo->{data_type}, 'INTEGER', 'column_info ok');
+ $schema->source("Artist")->column_info('artistid');
+ ok($schema->source("Artist")->{_columns_info_loaded} == 1, 'Columns info flag set');
+}
+
+# test remove_columns
+{
+ is_deeply([$schema->source('CD')->columns], [qw/cdid artist title year/]);
+ $schema->source('CD')->remove_columns('year');
+ is_deeply([$schema->source('CD')->columns], [qw/cdid artist title/]);
+}
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest::init_schema();
+
+plan tests => 3;
+
+# add some rows inside a transaction and commit it
+# XXX: Is storage->dbh the only way to get a dbh?
+$schema->storage->txn_begin;
+for (10..15) {
+ $schema->resultset("Artist")->create( {
+ artistid => $_,
+ name => "artist number $_",
+ } );
+}
+$schema->storage->txn_commit;
+my ($artist) = $schema->resultset("Artist")->find(15);
+is($artist->name, 'artist number 15', "Commit ok");
+
+# add some rows inside a transaction and roll it back
+$schema->storage->txn_begin;
+for (21..30) {
+ $schema->resultset("Artist")->create( {
+ artistid => $_,
+ name => "artist number $_",
+ } );
+}
+$schema->storage->txn_rollback;
+($artist) = $schema->resultset("Artist")->search( artistid => 25 );
+is($artist, undef, "Rollback ok");
+
+my $type_info = $schema->storage->columns_info_for('artist');
+
+# I know this is gross but SQLite reports the size differently from release
+# to release. At least this way the test still passes.
+
+delete $type_info->{artistid}{size};
+delete $type_info->{name}{size};
+
+my $test_type_info = {
+ 'artistid' => {
+ 'data_type' => 'INTEGER',
+ 'is_nullable' => 0,
+ },
+ 'name' => {
+ 'data_type' => 'varchar',
+ 'is_nullable' => 0,
+ },
+};
+is_deeply($type_info, $test_type_info, 'columns_info_for - column data types');
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest::init_schema();
+
+plan tests => 4;
+
+my $artist = DBICTest::Artist->find(1);
+ok($artist->find_related('twokeys', {cd => 1}), "find multiple pks using relationships + args");
+ok($schema->resultset("FourKeys")->find(1,2,3,4), "find multiple pks without hash");
+ok($schema->resultset("FourKeys")->find(5,4,3,6), "find multiple pks without hash");
+is($schema->resultset("FourKeys")->find(1,2,3,4)->ID, 'DBICTest::FourKeys|fourkeys|bar=2|foo=1|goodbye=4|hello=3', 'unique object id ok for multiple pks');
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest::init_schema();
+
+plan tests => 32;
+
+# has_a test
+my $cd = $schema->resultset("CD")->find(4);
+my ($artist) = ($INC{'DBICTest/HelperRels'}
+ ? $cd->artist
+ : $cd->search_related('artist'));
+is($artist->name, 'Random Boy Band', 'has_a search_related ok');
+
+# has_many test with an order_by clause defined
+$artist = $schema->resultset("Artist")->find(1);
+my @cds = ($INC{'DBICTest/HelperRels'}
+ ? $artist->cds
+ : $artist->search_related('cds'));
+is( $cds[1]->title, 'Spoonful of bees', 'has_many search_related with order_by ok' );
+
+# search_related with additional abstract query
+@cds = ($INC{'DBICTest/HelperRels'}
+ ? $artist->cds({ title => { like => '%of%' } })
+ : $artist->search_related('cds', { title => { like => '%of%' } } )
+ );
+is( $cds[1]->title, 'Forkful of bees', 'search_related with abstract query ok' );
+
+# creating a related object
+if ($INC{'DBICTest/HelperRels.pm'}) {
+ $artist->add_to_cds({ title => 'Big Flop', year => 2005 });
+} else {
+ $artist->create_related( 'cds', {
+ title => 'Big Flop',
+ year => 2005,
+ } );
+}
+
+is( ($artist->search_related('cds'))[3]->title, 'Big Flop', 'create_related ok' );
+
+my( $rs_from_list ) = $artist->search_related_rs('cds');
+is( ref($rs_from_list), 'DBIx::Class::ResultSet', 'search_related_rs in list context returns rs' );
+
+( $rs_from_list ) = $artist->cds_rs();
+is( ref($rs_from_list), 'DBIx::Class::ResultSet', 'relation_rs in list context returns rs' );
+
+# count_related
+is( $artist->count_related('cds'), 4, 'count_related ok' );
+
+# set_from_related
+my $track = $schema->resultset("Track")->create( {
+ trackid => 1,
+ cd => 3,
+ position => 98,
+ title => 'Hidden Track'
+} );
+$track->set_from_related( cd => $cd );
+
+is($track->disc->cdid, 4, 'set_from_related ok, including alternative accessor' );
+
+$track->set_from_related( cd => undef );
+
+ok( !defined($track->cd), 'set_from_related with undef ok');
+
+
+# update_from_related, the same as set_from_related, but it calls update afterwards
+$track = $schema->resultset("Track")->create( {
+ trackid => 2,
+ cd => 3,
+ position => 99,
+ title => 'Hidden Track'
+} );
+$track->update_from_related( cd => $cd );
+
+my $t_cd = ($schema->resultset("Track")->search( cd => 4, position => 99 ))[0]->cd;
+
+is( $t_cd->cdid, 4, 'update_from_related ok' );
+
+# find_or_create_related with an existing record
+$cd = $artist->find_or_create_related( 'cds', { title => 'Big Flop' } );
+is( $cd->year, 2005, 'find_or_create_related on existing record ok' );
+
+# find_or_create_related creating a new record
+$cd = $artist->find_or_create_related( 'cds', {
+ title => 'Greatest Hits',
+ year => 2006,
+} );
+is( $cd->title, 'Greatest Hits', 'find_or_create_related new record ok' );
+@cds = $artist->search_related('cds');
+is( ($artist->search_related('cds'))[4]->title, 'Greatest Hits', 'find_or_create_related new record search ok' );
+
+$artist->delete_related( cds => { title => 'Greatest Hits' });
+cmp_ok( $schema->resultset("CD")->search( title => 'Greatest Hits' ), '==', 0, 'delete_related ok' );
+
+# find_or_new_related with an existing record
+$cd = $artist->find_or_new_related( 'cds', { title => 'Big Flop' } );
+is( $cd->year, 2005, 'find_or_new_related on existing record ok' );
+ok( $cd->in_storage, 'find_or_new_related on existing record: is in_storage' );
+
+# find_or_new_related instantiating a new record
+$cd = $artist->find_or_new_related( 'cds', {
+ title => 'Greatest Hits 2: Louder Than Ever',
+ year => 2007,
+} );
+is( $cd->title, 'Greatest Hits 2: Louder Than Ever', 'find_or_new_related new record ok' );
+ok( ! $cd->in_storage, 'find_or_new_related on a new record: not in_storage' );
+
+SKIP: {
+ skip "relationship checking needs fixing", 1;
+ # try to add a bogus relationship using the wrong cols
+ eval {
+ DBICTest::Schema::Artist->add_relationship(
+ tracks => 'DBICTest::Schema::Track',
+ { 'foreign.cd' => 'self.cdid' }
+ );
+ };
+ like($@, qr/Unknown column/, 'failed when creating a rel with invalid key, ok');
+}
+
+# another bogus relationship using no join condition
+eval {
+ DBICTest::Schema::Artist->add_relationship( tracks => 'DBICTest::Track' );
+};
+like($@, qr/join condition/, 'failed when creating a rel without join condition, ok');
+
+# many_to_many helper test
+$cd = $schema->resultset("CD")->find(1);
+my @producers = $cd->producers();
+is( $producers[0]->name, 'Matt S Trout', 'many_to_many ok' );
+is( $cd->producers_sorted->next->name, 'Bob The Builder', 'sorted many_to_many ok' );
+is( $cd->producers_sorted(producerid => 3)->next->name, 'Fred The Phenotype', 'sorted many_to_many with search condition ok' );
+
+# test undirected many-to-many relationship (e.g. "related artists")
+my $undir_maps = $schema->resultset("Artist")->find(1)->artist_undirected_maps;
+is($undir_maps->count, 1, 'found 1 undirected map for artist 1');
+
+$undir_maps = $schema->resultset("Artist")->find(2)->artist_undirected_maps;
+is($undir_maps->count, 1, 'found 1 undirected map for artist 2');
+
+my $mapped_rs = $undir_maps->search_related('mapped_artists');
+
+my @art = $mapped_rs->all;
+
+cmp_ok(@art, '==', 2, "Both artist returned from map");
+
+my $searched = $mapped_rs->search({'mapped_artists.artistid' => {'!=', undef}});
+
+cmp_ok($searched->count, '==', 2, "Both artist returned from map after adding another condition");
+
+# check join through cascaded has_many relationships
+$artist = $schema->resultset("Artist")->find(1);
+my $trackset = $artist->cds->search_related('tracks');
+# LEFT join means we also see the trackless additional album...
+cmp_ok($trackset->count, '==', 11, "Correct number of tracks for artist");
+
+# now see about updating eveything that belongs to artist 2 to artist 3
+$artist = $schema->resultset("Artist")->find(2);
+my $nartist = $schema->resultset("Artist")->find(3);
+cmp_ok($artist->cds->count, '==', 1, "Correct orig #cds for artist");
+cmp_ok($nartist->cds->count, '==', 1, "Correct orig #cds for artist");
+$artist->cds->update({artist => $nartist->id});
+cmp_ok($artist->cds->count, '==', 0, "Correct new #cds for artist");
+cmp_ok($nartist->cds->count, '==', 2, "Correct new #cds for artist");
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest::init_schema();
+
+plan tests => 12;
+
+# first page
+my $it = $schema->resultset("CD")->search(
+ {},
+ { order_by => 'title',
+ rows => 3,
+ page => 1 }
+);
+
+is( $it->pager->entries_on_this_page, 3, "entries_on_this_page ok" );
+
+is( $it->pager->next_page, 2, "next_page ok" );
+
+is( $it->count, 3, "count on paged rs ok" );
+
+is( $it->next->title, "Caterwaulin' Blues", "iterator->next ok" );
+
+$it->next;
+$it->next;
+
+is( $it->next, undef, "next past end of page ok" );
+
+# second page, testing with array
+my @page2 = $schema->resultset("CD")->search(
+ {},
+ { order_by => 'title',
+ rows => 3,
+ page => 2 }
+);
+
+is( $page2[0]->title, "Generic Manufactured Singles", "second page first title ok" );
+
+# page a standard resultset
+$it = $schema->resultset("CD")->search(
+ {},
+ { order_by => 'title',
+ rows => 3 }
+);
+my $page = $it->page(2);
+
+is( $page->count, 2, "standard resultset paged rs count ok" );
+
+is( $page->next->title, "Generic Manufactured Singles", "second page of standard resultset ok" );
+
+# test software-based limit paging
+$it = $schema->resultset("CD")->search(
+ {},
+ { order_by => 'title',
+ rows => 3,
+ page => 2,
+ software_limit => 1 }
+);
+is( $it->pager->entries_on_this_page, 2, "software entries_on_this_page ok" );
+
+is( $it->pager->previous_page, 1, "software previous_page ok" );
+
+is( $it->count, 2, "software count on paged rs ok" );
+
+is( $it->next->title, "Generic Manufactured Singles", "software iterator->next ok" );
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest::init_schema();
+
+eval { require DateTime };
+plan skip_all => "Need DateTime for inflation tests" if $@;
+
+plan tests => 3;
+
+DBICTest::Schema::CD->inflate_column( 'year',
+ { inflate => sub { DateTime->new( year => shift ) },
+ deflate => sub { shift->year } }
+);
+Class::C3->reinitialize;
+
+# inflation test
+my $cd = $schema->resultset("CD")->find(3);
+
+is( ref($cd->year), 'DateTime', 'year is a DateTime, ok' );
+
+is( $cd->year->month, 1, 'inflated month ok' );
+
+# deflate test
+my $now = DateTime->now;
+$cd->year( $now );
+$cd->update;
+
+($cd) = $schema->resultset("CD")->search( year => $now->year );
+is( $cd->year->year, $now->year, 'deflate ok' );
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest::init_schema();
+
+eval { require DateTime };
+plan skip_all => "Need DateTime for inflation tests" if $@;
+
+plan tests => 6;
+
+DBICTest::Schema::CD->load_components(qw/CDBICompat::HasA/);
+
+DBICTest::Schema::CD->has_a( 'year', 'DateTime',
+ inflate => sub { DateTime->new( year => shift ) },
+ deflate => sub { shift->year }
+);
+Class::C3->reinitialize;
+
+# inflation test
+my $cd = $schema->resultset("CD")->find(3);
+
+is( ref($cd->year), 'DateTime', 'year is a DateTime, ok' );
+
+is( $cd->year->month, 1, 'inflated month ok' );
+
+# deflate test
+my $now = DateTime->now;
+$cd->year( $now );
+$cd->update;
+
+($cd) = $schema->resultset("CD")->search( year => $now->year );
+is( $cd->year->year, $now->year, 'deflate ok' );
+
+# re-test using alternate deflate syntax
+$schema->class("CD")->has_a( 'year', 'DateTime',
+ inflate => sub { DateTime->new( year => shift ) },
+ deflate => 'year'
+);
+
+# inflation test
+$cd = $schema->resultset("CD")->find(3);
+
+is( ref($cd->year), 'DateTime', 'year is a DateTime, ok' );
+
+is( $cd->year->month, 1, 'inflated month ok' );
+
+# deflate test
+$now = DateTime->now;
+$cd->year( $now );
+$cd->update;
+
+($cd) = $schema->resultset("CD")->search( year => $now->year );
+is( $cd->year->year, $now->year, 'deflate ok' );
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest::init_schema();
+
+use Data::Dumper;
+
+my @serializers = (
+ { module => 'YAML.pm',
+ inflater => sub { YAML::Load (shift) },
+ deflater => sub { die "Expecting a reference" unless (ref $_[0]); YAML::Dump (shift) },
+ },
+ { module => 'Storable.pm',
+ inflater => sub { Storable::thaw (shift) },
+ deflater => sub { die "Expecting a reference" unless (ref $_[0]); Storable::nfreeze (shift) },
+ },
+);
+
+
+my $selected;
+foreach my $serializer (@serializers) {
+ eval { require $serializer->{module} };
+ unless ($@) {
+ $selected = $serializer;
+ last;
+ }
+}
+
+plan (skip_all => "No suitable serializer found") unless $selected;
+
+plan (tests => 6);
+DBICTest::Schema::Serialized->inflate_column( 'serialized',
+ { inflate => $selected->{inflater},
+ deflate => $selected->{deflater},
+ },
+);
+Class::C3->reinitialize;
+
+my $complex1 = {
+ id => 1,
+ serialized => {
+ a => 1,
+ b => [
+ { c => 2 },
+ ],
+ d => 3,
+ },
+};
+
+my $complex2 = {
+ id => 1,
+ serialized => [
+ 'a',
+ { b => 1, c => 2},
+ 'd',
+ ],
+};
+
+my $rs = $schema->resultset('Serialized');
+my $entry = $rs->create({ id => 1, serialized => ''});
+
+my $inflated;
+
+ok($entry->update ({ %{$complex1} }), 'hashref deflation ok');
+ok($inflated = $entry->serialized, 'hashref inflation ok');
+is_deeply($inflated, $complex1->{serialized}, 'inflated hash matches original');
+
+ok($entry->update ({ %{$complex2} }), 'arrayref deflation ok');
+ok($inflated = $entry->serialized, 'arrayref inflation ok');
+is_deeply($inflated, $complex2->{serialized}, 'inflated array matches original');
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest::init_schema();
+
+BEGIN {
+ eval "use DBD::SQLite";
+ plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 3);
+}
+
+my $art = $schema->resultset("Artist")->find(1);
+
+isa_ok $art => 'DBICTest::Artist';
+
+my $name = 'Caterwauler McCrae';
+
+ok($art->name($name) eq $name, 'update');
+
+{
+ my @changed_keys = $art->is_changed;
+ is( scalar (@changed_keys), 0, 'field changed but same value' );
+}
+
+$art->discard_changes;
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest::init_schema();
+
+plan tests => 2;
+
+$schema->class("Artist")->load_components(qw/PK::Auto::SQLite/);
+ # Should just be PK::Auto but this ensures the compat shim works
+
+# add an artist without primary key to test Auto
+my $artist = $schema->resultset("Artist")->create( { name => 'Auto' } );
+$artist->name( 'Auto Change' );
+ok($artist->update, 'update on object created without PK ok');
+
+my $copied = $artist->copy({ name => 'Don\'t tell the RIAA', artistid => undef });
+is($copied->name, 'Don\'t tell the RIAA', "Copied with PKs ok.");
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MYSQL_${_}" } qw/DSN USER PASS/};
+
+#warn "$dsn $user $pass";
+
+plan skip_all => 'Set $ENV{DBICTEST_MYSQL_DSN}, _USER and _PASS to run this test'
+ unless ($dsn && $user);
+
+plan tests => 5;
+
+DBICTest::Schema->compose_connection('MySQLTest' => $dsn, $user, $pass);
+
+my $dbh = MySQLTest->schema->storage->dbh;
+
+$dbh->do("DROP TABLE IF EXISTS artist;");
+
+$dbh->do("CREATE TABLE artist (artistid INTEGER NOT NULL AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255), charfield CHAR(10));");
+
+#'dbi:mysql:host=localhost;database=dbic_test', 'dbic_test', '');
+
+MySQLTest::Artist->load_components('PK::Auto');
+
+# test primary key handling
+my $new = MySQLTest::Artist->create({ name => 'foo' });
+ok($new->artistid, "Auto-PK worked");
+
+# test LIMIT support
+for (1..6) {
+ MySQLTest::Artist->create({ name => 'Artist ' . $_ });
+}
+my $it = MySQLTest::Artist->search( {},
+ { rows => 3,
+ offset => 2,
+ order_by => 'artistid' }
+);
+is( $it->count, 3, "LIMIT count ok" );
+is( $it->next->name, "Artist 2", "iterator->next ok" );
+$it->next;
+$it->next;
+is( $it->next, undef, "next past end of resultset ok" );
+
+my $test_type_info = {
+ 'artistid' => {
+ 'data_type' => 'INT',
+ 'is_nullable' => 0,
+ 'size' => 11,
+ 'default_value' => undef,
+ },
+ 'name' => {
+ 'data_type' => 'VARCHAR',
+ 'is_nullable' => 1,
+ 'size' => 255,
+ 'default_value' => undef,
+ },
+ 'charfield' => {
+ 'data_type' => 'VARCHAR',
+ 'is_nullable' => 1,
+ 'size' => 10,
+ 'default_value' => undef,
+ },
+};
+
+
+my $type_info = MySQLTest->schema->storage->columns_info_for('artist');
+is_deeply($type_info, $test_type_info, 'columns_info_for - column data types');
+
+
+
+# clean up our mess
+$dbh->do("DROP TABLE artist");
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER PASS/};
+
+#warn "$dsn $user $pass";
+
+plan skip_all => 'Set $ENV{DBICTEST_PG_DSN}, _USER and _PASS to run this test'
+ . ' (note: creates and drops tables named artist and casecheck!)' unless ($dsn && $user);
+
+plan tests => 8;
+
+DBICTest::Schema->compose_connection('PgTest' => $dsn, $user, $pass);
+
+my $dbh = PgTest->schema->storage->dbh;
+PgTest->schema->source("Artist")->name("testschema.artist");
+$dbh->do("CREATE SCHEMA testschema;");
+$dbh->do("CREATE TABLE testschema.artist (artistid serial PRIMARY KEY, name VARCHAR(100), charfield CHAR(10));");
+ok ( $dbh->do('CREATE TABLE testschema.casecheck (id serial PRIMARY KEY, "name" VARCHAR(1), "NAME" VARCHAR(2), "UC_NAME" VARCHAR(3));'), 'Creation of casecheck table');
+
+PgTest::Artist->load_components('PK::Auto');
+
+my $new = PgTest::Artist->create({ name => 'foo' });
+
+is($new->artistid, 1, "Auto-PK worked");
+
+$new = PgTest::Artist->create({ name => 'bar' });
+
+is($new->artistid, 2, "Auto-PK worked");
+
+my $test_type_info = {
+ 'artistid' => {
+ 'data_type' => 'integer',
+ 'is_nullable' => 0,
+ 'size' => 4,
+ },
+ 'name' => {
+ 'data_type' => 'character varying',
+ 'is_nullable' => 1,
+ 'size' => 100,
+ 'default_value' => undef,
+ },
+ 'charfield' => {
+ 'data_type' => 'character',
+ 'is_nullable' => 1,
+ 'size' => 10,
+ 'default_value' => undef,
+ },
+};
+
+
+my $type_info = PgTest->schema->storage->columns_info_for('testschema.artist');
+my $artistid_defval = delete $type_info->{artistid}->{default_value};
+like($artistid_defval,
+ qr/^nextval\('([^\.]*\.){0,1}artist_artistid_seq'::(?:text|regclass)\)/,
+ 'columns_info_for - sequence matches Pg get_autoinc_seq expectations');
+is_deeply($type_info, $test_type_info,
+ 'columns_info_for - column data types');
+
+my $name_info = PgTest::Casecheck->column_info( 'name' );
+is( $name_info->{size}, 1, "Case sensitive matching info for 'name'" );
+
+my $NAME_info = PgTest::Casecheck->column_info( 'NAME' );
+is( $NAME_info->{size}, 2, "Case sensitive matching info for 'NAME'" );
+
+my $uc_name_info = PgTest::Casecheck->column_info( 'uc_name' );
+is( $uc_name_info->{size}, 3, "Case insensitive matching info for 'uc_name'" );
+
+$dbh->do("DROP TABLE testschema.artist;");
+$dbh->do("DROP TABLE testschema.casecheck;");
+$dbh->do("DROP SCHEMA testschema;");
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_ORA_${_}" } qw/DSN USER PASS/};
+
+plan skip_all => 'Set $ENV{DBICTEST_ORA_DSN}, _USER and _PASS to run this test. ' .
+ 'Warning: This test drops and creates tables called \'artist\', \'cd\' and \'track\''
+ unless ($dsn && $user && $pass);
+
+plan tests => 6;
+
+DBICTest::Schema->compose_connection('OraTest' => $dsn, $user, $pass);
+
+my $dbh = OraTest->schema->storage->dbh;
+
+eval {
+ $dbh->do("DROP SEQUENCE artist_seq");
+ $dbh->do("DROP TABLE artist");
+ $dbh->do("DROP TABLE cd");
+ $dbh->do("DROP TABLE track");
+};
+$dbh->do("CREATE SEQUENCE artist_seq START WITH 1 MAXVALUE 999999 MINVALUE 0");
+$dbh->do("CREATE TABLE artist (artistid NUMBER(12), name VARCHAR(255))");
+$dbh->do("CREATE TABLE cd (cdid NUMBER(12), artist NUMBER(12), title VARCHAR(255), year VARCHAR(4))");
+$dbh->do("CREATE TABLE track (trackid NUMBER(12), cd NUMBER(12), position NUMBER(12), title VARCHAR(255))");
+
+$dbh->do("ALTER TABLE artist ADD (CONSTRAINT artist_pk PRIMARY KEY (artistid))");
+$dbh->do(qq{
+ CREATE OR REPLACE TRIGGER artist_insert_trg
+ BEFORE INSERT ON artist
+ FOR EACH ROW
+ BEGIN
+ IF :new.artistid IS NULL THEN
+ SELECT artist_seq.nextval
+ INTO :new.artistid
+ FROM DUAL;
+ END IF;
+ END;
+});
+
+OraTest::Artist->load_components('PK::Auto');
+OraTest::CD->load_components('PK::Auto::Oracle');
+OraTest::Track->load_components('PK::Auto::Oracle');
+
+# test primary key handling
+my $new = OraTest::Artist->create({ name => 'foo' });
+is($new->artistid, 1, "Oracle Auto-PK worked");
+
+# test join with row count ambiguity
+my $cd = OraTest::CD->create({ cdid => 1, artist => 1, title => 'EP C', year => '2003' });
+my $track = OraTest::Track->create({ trackid => 1, cd => 1, position => 1, title => 'Track1' });
+my $tjoin = OraTest::Track->search({ 'me.title' => 'Track1'},
+ { join => 'cd',
+ rows => 2 }
+);
+
+is($tjoin->next->title, 'Track1', "ambiguous column ok");
+
+# check count distinct with multiple columns
+my $other_track = OraTest::Track->create({ trackid => 2, cd => 1, position => 1, title => 'Track2' });
+my $tcount = OraTest::Track->search(
+ {},
+ {
+ select => [{count => {distinct => ['position', 'title']}}],
+ as => ['count']
+ }
+ );
+
+is($tcount->next->get_column('count'), 2, "multiple column select distinct ok");
+
+# test LIMIT support
+for (1..6) {
+ OraTest::Artist->create({ name => 'Artist ' . $_ });
+}
+my $it = OraTest::Artist->search( {},
+ { rows => 3,
+ offset => 2,
+ order_by => 'artistid' }
+);
+is( $it->count, 3, "LIMIT count ok" );
+is( $it->next->name, "Artist 2", "iterator->next ok" );
+$it->next;
+$it->next;
+is( $it->next, undef, "next past end of resultset ok" );
+
+# clean up our mess
+$dbh->do("DROP SEQUENCE artist_seq");
+$dbh->do("DROP TABLE artist");
+$dbh->do("DROP TABLE cd");
+$dbh->do("DROP TABLE track");
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_DB2_${_}" } qw/DSN USER PASS/};
+
+#warn "$dsn $user $pass";
+
+plan skip_all => 'Set $ENV{DBICTEST_DB2_DSN}, _USER and _PASS to run this test'
+ unless ($dsn && $user);
+
+plan tests => 6;
+
+DBICTest::Schema->compose_connection('DB2Test' => $dsn, $user, $pass);
+
+my $dbh = DB2Test->schema->storage->dbh;
+
+$dbh->do("DROP TABLE artist", { RaiseError => 0, PrintError => 0 });
+
+$dbh->do("CREATE TABLE artist (artistid INTEGER GENERATED BY DEFAULT AS IDENTITY (START WITH 1, INCREMENT BY 1), name VARCHAR(255), charfield CHAR(10));");
+
+#'dbi:mysql:host=localhost;database=dbic_test', 'dbic_test', '');
+
+DB2Test::Artist->load_components('PK::Auto');
+
+# test primary key handling
+my $new = DB2Test::Artist->create({ name => 'foo' });
+ok($new->artistid, "Auto-PK worked");
+
+# test LIMIT support
+for (1..6) {
+ DB2Test::Artist->create({ name => 'Artist ' . $_ });
+}
+my $it = DB2Test::Artist->search( {},
+ { rows => 3,
+ order_by => 'artistid'
+ }
+);
+is( $it->count, 3, "LIMIT count ok" );
+is( $it->next->name, "foo", "iterator->next ok" );
+$it->next;
+is( $it->next->name, "Artist 2", "iterator->next ok" );
+is( $it->next, undef, "next past end of resultset ok" );
+
+my $test_type_info = {
+ 'artistid' => {
+ 'data_type' => 'INTEGER',
+ 'is_nullable' => 0,
+ 'size' => 10
+ },
+ 'name' => {
+ 'data_type' => 'VARCHAR',
+ 'is_nullable' => 1,
+ 'size' => 255
+ },
+ 'charfield' => {
+ 'data_type' => 'CHAR',
+ 'is_nullable' => 1,
+ 'size' => 10
+ },
+};
+
+
+my $type_info = DB2Test->schema->storage->columns_info_for('artist');
+is_deeply($type_info, $test_type_info, 'columns_info_for - column data types');
+
+
+
+# clean up our mess
+$dbh->do("DROP TABLE artist");
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_DB2_400_${_}" } qw/DSN USER PASS/};
+
+#warn "$dsn $user $pass";
+
+# Probably best to pass the DBQ option in the DSN to specify a specific
+# libray. Something like:
+# DBICTEST_DB2_400_DSN='dbi:ODBC:dsn=MyAS400;DBQ=MYLIB'
+plan skip_all => 'Set $ENV{DBICTEST_DB2_400_DSN}, _USER and _PASS to run this test'
+ unless ($dsn && $user);
+
+plan tests => 6;
+
+DBICTest::Schema->compose_connection('DB2Test' => $dsn, $user, $pass);
+
+my $dbh = DB2Test->schema->storage->dbh;
+
+$dbh->do("DROP TABLE artist", { RaiseError => 0, PrintError => 0 });
+
+$dbh->do("CREATE TABLE artist (artistid INTEGER GENERATED BY DEFAULT AS IDENTITY (START WITH 1, INCREMENT BY 1), name VARCHAR(255), charfield CHAR(10))");
+
+DB2Test::Artist->load_components('PK::Auto');
+
+# test primary key handling
+my $new = DB2Test::Artist->create({ name => 'foo' });
+ok($new->artistid, "Auto-PK worked");
+
+# test LIMIT support
+for (1..6) {
+ DB2Test::Artist->create({ name => 'Artist ' . $_ });
+}
+my $it = DB2Test::Artist->search( {},
+ { rows => 3,
+ order_by => 'artistid'
+ }
+);
+is( $it->count, 3, "LIMIT count ok" );
+is( $it->next->name, "foo", "iterator->next ok" );
+$it->next;
+is( $it->next->name, "Artist 2", "iterator->next ok" );
+is( $it->next, undef, "next past end of resultset ok" );
+
+my $test_type_info = {
+ 'artistid' => {
+ 'data_type' => 'INTEGER',
+ 'is_nullable' => 0,
+ 'size' => 10
+ },
+ 'name' => {
+ 'data_type' => 'VARCHAR',
+ 'is_nullable' => 1,
+ 'size' => 255
+ },
+ 'charfield' => {
+ 'data_type' => 'CHAR',
+ 'is_nullable' => 1,
+ 'size' => 10
+ },
+};
+
+
+my $type_info = DB2Test->schema->storage->columns_info_for('artist');
+is_deeply($type_info, $test_type_info, 'columns_info_for - column data types');
+
+
+
+# clean up our mess
+$dbh->do("DROP TABLE artist");
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_${_}" } qw/DSN USER PASS/};
+
+#warn "$dsn $user $pass";
+
+plan skip_all => 'Set $ENV{DBICTEST_MSSQL_DSN}, _USER and _PASS to run this test'
+ unless ($dsn);
+
+plan tests => 4;
+
+DBICTest::Schema->compose_connection( 'MSSQLTest' => $dsn, $user, $pass );
+
+my $dbh = MSSQLTest->schema->storage->dbh;
+
+$dbh->do("IF OBJECT_ID('artist', 'U') IS NOT NULL
+ DROP TABLE artist");
+
+$dbh->do("CREATE TABLE artist (artistid INT IDENTITY PRIMARY KEY, name VARCHAR(255));");
+
+MSSQLTest::Artist->load_components('PK::Auto::MSSQL');
+
+# Test PK
+my $new = MSSQLTest::Artist->create( { name => 'foo' } );
+ok($new->artistid, "Auto-PK worked");
+
+# Test LIMIT
+for (1..6) {
+ MSSQLTest::Artist->create( { name => 'Artist ' . $_ } );
+}
+
+my $it = MSSQLTest::Artist->search( { },
+ { rows => 3,
+ offset => 2,
+ order_by => 'artistid'
+ }
+);
+
+is( $it->count, 3, "LIMIT count ok" );
+ok( $it->next->name, "iterator->next ok" );
+$it->next;
+$it->next;
+is( $it->next, undef, "next past end of resultset ok" );
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest::init_schema();
+
+BEGIN {
+ eval "use DBD::SQLite";
+ plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 9);
+}
+
+# test LIMIT
+my $it = $schema->resultset("CD")->search( {},
+ { rows => 3,
+ order_by => 'title' }
+);
+is( $it->count, 3, "count ok" );
+is( $it->next->title, "Caterwaulin' Blues", "iterator->next ok" );
+$it->next;
+$it->next;
+is( $it->next, undef, "next past end of resultset ok" );
+
+# test OFFSET
+my @cds = $schema->resultset("CD")->search( {},
+ { rows => 2,
+ offset => 2,
+ order_by => 'year' }
+);
+is( $cds[0]->title, "Spoonful of bees", "offset ok" );
+
+# test software-based limiting
+$it = $schema->resultset("CD")->search( {},
+ { rows => 3,
+ software_limit => 1,
+ order_by => 'title' }
+);
+is( $it->count, 3, "software limit count ok" );
+is( $it->next->title, "Caterwaulin' Blues", "software iterator->next ok" );
+$it->next;
+$it->next;
+is( $it->next, undef, "software next past end of resultset ok" );
+
+@cds = $schema->resultset("CD")->search( {},
+ { rows => 2,
+ offset => 2,
+ software_limit => 1,
+ order_by => 'year' }
+);
+is( $cds[0]->title, "Spoonful of bees", "software offset ok" );
+
+# based on a failing criteria submitted by waswas
+# requires SQL::Abstract >= 1.20
+$it = $schema->resultset("CD")->search(
+ { title => [
+ -and =>
+ {
+ -like => '%bees'
+ },
+ {
+ -not_like => 'Forkful%'
+ }
+ ]
+ },
+ { rows => 5 }
+);
+is( $it->count, 1, "complex abstract count ok" );
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest::init_schema();
+
+use IO::File;
+
+BEGIN {
+ eval "use DBD::SQLite";
+ plan $@
+ ? ( skip_all => 'needs DBD::SQLite for testing' )
+ : ( tests => 42 );
+}
+
+# figure out if we've got a version of sqlite that is older than 3.2.6, in
+# which case COUNT(DISTINCT()) doesn't work
+my $is_broken_sqlite = 0;
+my ($sqlite_major_ver,$sqlite_minor_ver,$sqlite_patch_ver) =
+ split /\./, $schema->storage->dbh->get_info(18);
+if( $schema->storage->dbh->get_info(17) eq 'SQLite' &&
+ ( ($sqlite_major_ver < 3) ||
+ ($sqlite_major_ver == 3 && $sqlite_minor_ver < 2) ||
+ ($sqlite_major_ver == 3 && $sqlite_minor_ver == 2 && $sqlite_patch_ver < 6) ) ) {
+ $is_broken_sqlite = 1;
+}
+
+# test the abstract join => SQL generator
+my $sa = new DBIC::SQL::Abstract;
+
+my @j = (
+ { child => 'person' },
+ [ { father => 'person' }, { 'father.person_id' => 'child.father_id' }, ],
+ [ { mother => 'person' }, { 'mother.person_id' => 'child.mother_id' } ],
+);
+my $match = 'person child JOIN person father ON ( father.person_id = '
+ . 'child.father_id ) JOIN person mother ON ( mother.person_id '
+ . '= child.mother_id )'
+ ;
+is( $sa->_recurse_from(@j), $match, 'join 1 ok' );
+
+my @j2 = (
+ { mother => 'person' },
+ [ [ { child => 'person' },
+ [ { father => 'person' },
+ { 'father.person_id' => 'child.father_id' }
+ ]
+ ],
+ { 'mother.person_id' => 'child.mother_id' }
+ ],
+);
+$match = 'person mother JOIN (person child JOIN person father ON ('
+ . ' father.person_id = child.father_id )) ON ( mother.person_id = '
+ . 'child.mother_id )'
+ ;
+is( $sa->_recurse_from(@j2), $match, 'join 2 ok' );
+
+my @j3 = (
+ { child => 'person' },
+ [ { father => 'person', -join_type => 'inner' }, { 'father.person_id' => 'child.father_id' }, ],
+ [ { mother => 'person', -join_type => 'inner' }, { 'mother.person_id' => 'child.mother_id' } ],
+);
+$match = 'person child INNER JOIN person father ON ( father.person_id = '
+ . 'child.father_id ) INNER JOIN person mother ON ( mother.person_id '
+ . '= child.mother_id )'
+ ;
+
+is( $sa->_recurse_from(@j3), $match, 'join 3 (inner join) ok');
+
+my $rs = $schema->resultset("CD")->search(
+ { 'year' => 2001, 'artist.name' => 'Caterwauler McCrae' },
+ { from => [ { 'me' => 'cd' },
+ [
+ { artist => 'artist' },
+ { 'me.artist' => 'artist.artistid' }
+ ] ] }
+ );
+
+cmp_ok( $rs + 0, '==', 1, "Single record in resultset");
+
+is($rs->first->title, 'Forkful of bees', 'Correct record returned');
+
+$rs = $schema->resultset("CD")->search(
+ { 'year' => 2001, 'artist.name' => 'Caterwauler McCrae' },
+ { join => 'artist' });
+
+cmp_ok( $rs + 0, '==', 1, "Single record in resultset");
+
+is($rs->first->title, 'Forkful of bees', 'Correct record returned');
+
+$rs = $schema->resultset("CD")->search(
+ { 'artist.name' => 'We Are Goth',
+ 'liner_notes.notes' => 'Kill Yourself!' },
+ { join => [ qw/artist liner_notes/ ] });
+
+cmp_ok( $rs + 0, '==', 1, "Single record in resultset");
+
+is($rs->first->title, 'Come Be Depressed With Us', 'Correct record returned');
+
+# when using join attribute, make sure slice()ing all objects has same count as all()
+$rs = $schema->resultset("CD")->search(
+ { 'artist' => 1 },
+ { join => [qw/artist/], order_by => 'artist.name' }
+);
+cmp_ok( scalar $rs->all, '==', scalar $rs->slice(0, $rs->count - 1), 'slice() with join has same count as all()' );
+
+$rs = $schema->resultset("Artist")->search(
+ { 'liner_notes.notes' => 'Kill Yourself!' },
+ { join => { 'cds' => 'liner_notes' } });
+
+cmp_ok( $rs->count, '==', 1, "Single record in resultset");
+
+is($rs->first->name, 'We Are Goth', 'Correct record returned');
+
+$rs = $schema->resultset("CD")->search(
+ { 'artist.name' => 'Caterwauler McCrae' },
+ { prefetch => [ qw/artist liner_notes/ ],
+ order_by => 'me.cdid' });
+
+cmp_ok($rs + 0, '==', 3, 'Correct number of records returned');
+
+my $queries = 0;
+$schema->storage->debugcb(sub { $queries++ });
+
+$queries = 0;
+$schema->storage->debug(1);
+
+my @cd = $rs->all;
+
+is($cd[0]->title, 'Spoonful of bees', 'First record returned ok');
+
+ok(!defined $cd[0]->liner_notes, 'No prefetch for NULL LEFT join');
+
+is($cd[1]->{_relationship_data}{liner_notes}->notes, 'Buy Whiskey!', 'Prefetch for present LEFT JOIN');
+
+is(ref $cd[1]->liner_notes, 'DBICTest::LinerNotes', 'Prefetch returns correct class');
+
+is($cd[2]->{_inflated_column}{artist}->name, 'Caterwauler McCrae', 'Prefetch on parent object ok');
+
+is($queries, 1, 'prefetch ran only 1 select statement');
+
+$schema->storage->debug(0);
+
+# test for partial prefetch via columns attr
+my $cd = $schema->resultset('CD')->find(1,
+ {
+ columns => [qw/title artist.name/],
+ join => { 'artist' => {} }
+ }
+);
+ok(eval { $cd->artist->name eq 'Caterwauler McCrae' }, 'single related column prefetched');
+
+# start test for nested prefetch SELECT count
+$queries = 0;
+$schema->storage->debug(1);
+
+$rs = $schema->resultset('Tag')->search(
+ {},
+ {
+ prefetch => { cd => 'artist' }
+ }
+);
+
+my $tag = $rs->first;
+
+is( $tag->cd->title, 'Spoonful of bees', 'step 1 ok for nested prefetch' );
+
+is( $tag->cd->artist->name, 'Caterwauler McCrae', 'step 2 ok for nested prefetch');
+
+# count the SELECTs
+#$selects++ if /SELECT(?!.*WHERE 1=0.*)/;
+is($queries, 1, 'nested prefetch ran exactly 1 select statement (excluding column_info)');
+
+$queries = 0;
+
+$cd = $schema->resultset('CD')->find(1, { prefetch => 'artist' });
+
+is($cd->{_inflated_column}{artist}->name, 'Caterwauler McCrae', 'artist prefetched correctly on find');
+
+is($queries, 1, 'find with prefetch ran exactly 1 select statement (excluding column_info)');
+
+$schema->storage->debug(0);
+
+$rs = $schema->resultset('Tag')->search(
+ {},
+ {
+ join => { cd => 'artist' },
+ prefetch => { cd => 'artist' }
+ }
+);
+
+cmp_ok( $rs->count, '>=', 0, 'nested prefetch does not duplicate joins' );
+
+my ($artist) = $schema->resultset("Artist")->search({ 'cds.year' => 2001 },
+ { order_by => 'artistid DESC', join => 'cds' });
+
+is($artist->name, 'Random Boy Band', "Join search by object ok");
+
+my @cds = $schema->resultset("CD")->search({ 'liner_notes.notes' => 'Buy Merch!' },
+ { join => 'liner_notes' });
+
+cmp_ok(scalar @cds, '==', 1, "Single CD retrieved via might_have");
+
+is($cds[0]->title, "Generic Manufactured Singles", "Correct CD retrieved");
+
+my @artists = $schema->resultset("Artist")->search({ 'tags.tag' => 'Shiny' },
+ { join => { 'cds' => 'tags' } });
+
+cmp_ok( @artists, '==', 2, "two-join search ok" );
+
+$rs = $schema->resultset("CD")->search(
+ {},
+ { group_by => [qw/ title me.cdid /] }
+);
+
+SKIP: {
+ skip "SQLite < 3.2.6 doesn't understand COUNT(DISTINCT())", 1
+ if $is_broken_sqlite;
+ cmp_ok( $rs->count, '==', 5, "count() ok after group_by on main pk" );
+}
+
+cmp_ok( scalar $rs->all, '==', 5, "all() returns same count as count() after group_by on main pk" );
+
+$rs = $schema->resultset("CD")->search(
+ {},
+ { join => [qw/ artist /], group_by => [qw/ artist.name /] }
+);
+
+SKIP: {
+ skip "SQLite < 3.2.6 doesn't understand COUNT(DISTINCT())", 1
+ if $is_broken_sqlite;
+ cmp_ok( $rs->count, '==', 3, "count() ok after group_by on related column" );
+}
+
+$rs = $schema->resultset("Artist")->search(
+ {},
+ { join => [qw/ cds /], group_by => [qw/ me.name /], having =>{ 'MAX(cds.cdid)'=> \'< 5' } }
+);
+
+cmp_ok( $rs->all, '==', 2, "results ok after group_by on related column with a having" );
+
+$rs = $rs->search( undef, { having =>{ 'count(*)'=> \'> 2' }});
+
+cmp_ok( $rs->all, '==', 1, "count() ok after group_by on related column with a having" );
+
+$rs = $schema->resultset("Artist")->search(
+ { 'cds.title' => 'Spoonful of bees',
+ 'cds_2.title' => 'Forkful of bees' },
+ { join => [ 'cds', 'cds' ] });
+
+SKIP: {
+ skip "SQLite < 3.2.6 doesn't understand COUNT(DISTINCT())", 1
+ if $is_broken_sqlite;
+ cmp_ok($rs->count, '==', 1, "single artist returned from multi-join");
+}
+
+is($rs->next->name, 'Caterwauler McCrae', "Correct artist returned");
+
+$queries = 0;
+$schema->storage->debug(1);
+
+my $tree_like =
+ $schema->resultset('TreeLike')->find(4,
+ { join => { parent => { parent => 'parent' } },
+ prefetch => { parent => { parent => 'parent' } } });
+
+is($tree_like->name, 'quux', 'Bottom of tree ok');
+$tree_like = $tree_like->parent;
+is($tree_like->name, 'baz', 'First level up ok');
+$tree_like = $tree_like->parent;
+is($tree_like->name, 'bar', 'Second level up ok');
+$tree_like = $tree_like->parent;
+is($tree_like->name, 'foo', 'Third level up ok');
+
+$schema->storage->debug(0);
+
+cmp_ok($queries, '==', 1, 'Only one query run');
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest::init_schema();
+
+eval "use DBD::SQLite";
+plan skip_all => 'needs DBD::SQLite for testing' if $@;
+plan tests => 4;
+
+cmp_ok($schema->resultset("CD")->count({ 'artist.name' => 'Caterwauler McCrae' },
+ { join => 'artist' }),
+ '==', 3, 'Count by has_a ok');
+
+cmp_ok($schema->resultset("CD")->count({ 'tags.tag' => 'Blue' }, { join => 'tags' }),
+ '==', 4, 'Count by has_many ok');
+
+cmp_ok($schema->resultset("CD")->count(
+ { 'liner_notes.notes' => { '!=' => undef } },
+ { join => 'liner_notes' }),
+ '==', 3, 'Count by might_have ok');
+
+cmp_ok($schema->resultset("CD")->count(
+ { 'year' => { '>', 1998 }, 'tags.tag' => 'Cheesy',
+ 'liner_notes.notes' => { 'like' => 'Buy%' } },
+ { join => [ qw/tags liner_notes/ ] } ),
+ '==', 2, "Mixed count ok");
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest::init_schema();
+
+# this test will check to see if you can have 2 columns
+# in the same class pointing at the same other class
+#
+# example:
+#
+# +---------+ +--------------+
+# | SelfRef | | SelfRefAlias |
+# +---------+ 1-M +--------------+
+# | id |-------| self_ref | --+
+# | name | | alias | --+
+# +---------+ +--------------+ |
+# /|\ |
+# | |
+# +--------------------------------+
+#
+# see http://use.perl.org/~LTjake/journal/24876 for the
+# issue with CDBI
+
+plan tests => 4;
+
+my $item = $schema->resultset("SelfRef")->find( 1 );
+is( $item->name, 'First', 'proper start item' );
+
+my @aliases = $item->aliases;
+
+is( scalar @aliases, 1, 'proper number of aliases' );
+
+my $orig = $aliases[ 0 ]->self_ref;
+my $alias = $aliases[ 0 ]->alias;
+
+is( $orig->name, 'First', 'proper original' );
+is( $alias->name, 'Second', 'proper alias' );
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest::init_schema();
+
+eval 'use Data::UUID ; 1'
+ or plan skip_all => 'Install Data::UUID run this test';
+
+plan tests => 1;
+DBICTest::Schema::Artist->load_components('UUIDColumns');
+DBICTest::Schema::Artist->uuid_columns('name');
+Class::C3->reinitialize();
+
+my $artist = $schema->resultset("Artist")->create( { artistid => 100 } );
+like $artist->name, qr/[\w-]{36}/, 'got something like uuid';
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest::init_schema();
+
+plan tests => 34;
+
+my $artistid = 1;
+my $title = 'UNIQUE Constraint';
+
+my $cd1 = $schema->resultset('CD')->find_or_create({
+ artist => $artistid,
+ title => $title,
+ year => 2005,
+});
+
+my $cd2 = $schema->resultset('CD')->find(
+ {
+ artist => $artistid,
+ title => $title,
+ },
+ { key => 'artist_title' }
+);
+
+is($cd2->get_column('artist'), $cd1->get_column('artist'), 'find by specific key: artist is correct');
+is($cd2->title, $cd1->title, 'title is correct');
+is($cd2->year, $cd1->year, 'year is correct');
+
+my $cd3 = $schema->resultset('CD')->find($artistid, $title, { key => 'artist_title' });
+
+is($cd3->get_column('artist'), $cd1->get_column('artist'), 'find by specific key, ordered columns: artist is correct');
+is($cd3->title, $cd1->title, 'title is correct');
+is($cd3->year, $cd1->year, 'year is correct');
+
+my $cd4 = $schema->resultset('CD')->update_or_create(
+ {
+ artist => $artistid,
+ title => $title,
+ year => 2007,
+ },
+);
+
+ok(! $cd4->is_changed, 'update_or_create without key: row is clean');
+is($cd4->cdid, $cd2->cdid, 'cdid is correct');
+is($cd4->get_column('artist'), $cd2->get_column('artist'), 'artist is correct');
+is($cd4->title, $cd2->title, 'title is correct');
+is($cd4->year, 2007, 'updated year is correct');
+
+my $cd5 = $schema->resultset('CD')->update_or_create(
+ {
+ artist => $artistid,
+ title => $title,
+ year => 2007,
+ },
+ { key => 'artist_title' }
+);
+
+ok(! $cd5->is_changed, 'update_or_create by specific key: row is clean');
+is($cd5->cdid, $cd2->cdid, 'cdid is correct');
+is($cd5->get_column('artist'), $cd2->get_column('artist'), 'artist is correct');
+is($cd5->title, $cd2->title, 'title is correct');
+is($cd5->year, 2007, 'updated year is correct');
+
+my $cd6 = $schema->resultset('CD')->update_or_create(
+ {
+ cdid => $cd2->cdid,
+ artist => 1,
+ title => $cd2->title,
+ year => 2005,
+ },
+ { key => 'primary' }
+);
+
+ok(! $cd6->is_changed, 'update_or_create by PK: row is clean');
+is($cd6->cdid, $cd2->cdid, 'cdid is correct');
+is($cd6->get_column('artist'), $cd2->get_column('artist'), 'artist is correct');
+is($cd6->title, $cd2->title, 'title is correct');
+is($cd6->year, 2005, 'updated year is correct');
+
+my $cd7 = $schema->resultset('CD')->find_or_create(
+ {
+ artist => $artistid,
+ title => $title,
+ year => 2010,
+ },
+ { key => 'artist_title' }
+);
+
+is($cd7->cdid, $cd1->cdid, 'find_or_create by specific key: cdid is correct');
+is($cd7->get_column('artist'), $cd1->get_column('artist'), 'artist is correct');
+is($cd7->title, $cd1->title, 'title is correct');
+is($cd7->year, $cd1->year, 'year is correct');
+
+my $artist = $schema->resultset('Artist')->find($artistid);
+my $cd8 = $artist->find_or_create_related('cds',
+ {
+ artist => $artistid,
+ title => $title,
+ year => 2020,
+ },
+ { key => 'artist_title' }
+);
+
+is($cd8->cdid, $cd1->cdid, 'find_or_create related by specific key: cdid is correct');
+is($cd8->get_column('artist'), $cd1->get_column('artist'), 'artist is correct');
+is($cd8->title, $cd1->title, 'title is correct');
+is($cd8->year, $cd1->year, 'year is correct');
+
+my $cd9 = $artist->update_or_create_related('cds',
+ {
+ artist => $artistid,
+ title => $title,
+ year => 2021,
+ },
+ { key => 'artist_title' }
+);
+
+ok(! $cd9->is_changed, 'update_or_create by specific key: row is clean');
+is($cd9->cdid, $cd1->cdid, 'cdid is correct');
+is($cd9->get_column('artist'), $cd1->get_column('artist'), 'artist is correct');
+is($cd9->title, $cd1->title, 'title is correct');
+is($cd9->year, 2021, 'year is correct');
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest::init_schema();
+
+plan tests => 39;
+
+my $code = sub {
+ my ($artist, @cd_titles) = @_;
+
+ $artist->create_related('cds', {
+ title => $_,
+ year => 2006,
+ }) foreach (@cd_titles);
+
+ return $artist->cds->all;
+};
+
+# Test checking of parameters
+{
+ eval {
+ (ref $schema)->txn_do(sub{});
+ };
+ like($@, qr/class method/, '$self parameter check ok');
+ eval {
+ $schema->txn_do('');
+ };
+ like($@, qr/must be a CODE reference/, '$coderef parameter check ok');
+}
+
+# Test successful txn_do() - scalar context
+{
+ my @titles = map {'txn_do test CD ' . $_} (1..5);
+ my $artist = $schema->resultset('Artist')->find(1);
+ my $count_before = $artist->cds->count;
+ my $count_after = $schema->txn_do($code, $artist, @titles);
+ is($count_after, $count_before+5, 'successful txn added 5 cds');
+ is($artist->cds({
+ title => "txn_do test CD $_",
+ })->first->year, 2006, "new CD $_ year correct") for (1..5);
+}
+
+# Test successful txn_do() - list context
+{
+ my @titles = map {'txn_do test CD ' . $_} (6..10);
+ my $artist = $schema->resultset('Artist')->find(1);
+ my $count_before = $artist->cds->count;
+ my @cds = $schema->txn_do($code, $artist, @titles);
+ is(scalar @cds, $count_before+5, 'added 5 CDs and returned in list context');
+ is($artist->cds({
+ title => "txn_do test CD $_",
+ })->first->year, 2006, "new CD $_ year correct") for (6..10);
+}
+
+# Test nested successful txn_do()
+{
+ my $nested_code = sub {
+ my ($schema, $artist, $code) = @_;
+
+ my @titles1 = map {'nested txn_do test CD ' . $_} (1..5);
+ my @titles2 = map {'nested txn_do test CD ' . $_} (6..10);
+
+ $schema->txn_do($code, $artist, @titles1);
+ $schema->txn_do($code, $artist, @titles2);
+ };
+
+ my $artist = $schema->resultset('Artist')->find(2);
+ my $count_before = $artist->cds->count;
+
+ eval {
+ $schema->txn_do($nested_code, $schema, $artist, $code);
+ };
+
+ my $error = $@;
+
+ ok(!$error, 'nested txn_do succeeded');
+ is($artist->cds({
+ title => 'nested txn_do test CD '.$_,
+ })->first->year, 2006, qq{nested txn_do CD$_ year ok}) for (1..10);
+ is($artist->cds->count, $count_before+10, 'nested txn_do added all CDs');
+}
+
+my $fail_code = sub {
+ my ($artist) = @_;
+ $artist->create_related('cds', {
+ title => 'this should not exist',
+ year => 2005,
+ });
+ die "the sky is falling";
+};
+
+# Test failed txn_do()
+{
+ my $artist = $schema->resultset('Artist')->find(3);
+
+ eval {
+ $schema->txn_do($fail_code, $artist);
+ };
+
+ my $error = $@;
+
+ like($error, qr/the sky is falling/, 'failed txn_do threw an exception');
+ my $cd = $artist->cds({
+ title => 'this should not exist',
+ year => 2005,
+ })->first;
+ ok(!defined($cd), q{failed txn_do didn't change the cds table});
+}
+
+# Test failed txn_do() with failed rollback
+{
+ my $artist = $schema->resultset('Artist')->find(3);
+
+ # Force txn_rollback() to throw an exception
+ no warnings 'redefine';
+ no strict 'refs';
+ local *{"DBIx::Class::Schema::txn_rollback"} = sub{die 'FAILED'};
+
+ eval {
+ $schema->txn_do($fail_code, $artist);
+ };
+
+ my $error = $@;
+
+ like($error, qr/Rollback failed/, 'failed txn_do with a failed '.
+ 'txn_rollback threw a rollback exception');
+ like($error, qr/the sky is falling/, 'failed txn_do with a failed '.
+ 'txn_rollback included the original exception');
+
+ my $cd = $artist->cds({
+ title => 'this should not exist',
+ year => 2005,
+ })->first;
+ isa_ok($cd, 'DBICTest::CD', q{failed txn_do with a failed txn_rollback }.
+ q{changed the cds table});
+ $cd->delete; # Rollback failed
+ $cd = $artist->cds({
+ title => 'this should not exist',
+ year => 2005,
+ })->first;
+ ok(!defined($cd), q{deleted the failed txn's cd});
+ $schema->storage->{transaction_depth} = 0; # Must reset this or further tests
+ # will fail
+}
+
+# Test nested failed txn_do()
+{
+ my $nested_fail_code = sub {
+ my ($schema, $artist, $code1, $code2) = @_;
+
+ my @titles = map {'nested txn_do test CD ' . $_} (1..5);
+
+ $schema->txn_do($code1, $artist, @titles); # successful txn
+ $schema->txn_do($code2, $artist); # failed txn
+ };
+
+ my $artist = $schema->resultset('Artist')->find(3);
+
+ eval {
+ $schema->txn_do($nested_fail_code, $schema, $artist, $code, $fail_code);
+ };
+
+ my $error = $@;
+
+ like($error, qr/the sky is falling/, 'nested failed txn_do threw exception');
+ ok(!defined($artist->cds({
+ title => 'nested txn_do test CD '.$_,
+ year => 2006,
+ })->first), qq{failed txn_do didn't add first txn's cd $_}) for (1..5);
+ my $cd = $artist->cds({
+ title => 'this should not exist',
+ year => 2005,
+ })->first;
+ ok(!defined($cd), q{failed txn_do didn't add failed txn's cd});
+}
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest::init_schema();
+
+plan tests => 4;
+my $artist = $schema->resultset('Artist')->find(1);
+my $artist_cds = $artist->search_related('cds');
+
+my $cover_band;
+
+{
+ no warnings 'redefine';
+ local *DBICTest::Artist::result_source_instance = \&DBICTest::Schema::Artist::result_source_instance;
+
+ $cover_band = $artist->copy;
+}
+
+my $cover_cds = $cover_band->search_related('cds');
+cmp_ok($cover_band->id, '!=', $artist->id, 'ok got new column id...');
+is($cover_cds->count, $artist_cds->count, 'duplicated rows count ok');
+
+#check multi-keyed
+cmp_ok($cover_band->search_related('twokeys')->count, '>', 0, 'duplicated multiPK ok');
+
+#and check copying a few relations away
+cmp_ok($cover_cds->search_related('tags')->count, '==',
+ $artist_cds->search_related('tags')->count , 'duplicated count ok');
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest::init_schema();
+
+my $queries;
+$schema->storage->debugcb( sub{ $queries++ } );
+
+eval "use DBD::SQLite";
+plan skip_all => 'needs DBD::SQLite for testing' if $@;
+plan tests => 22;
+
+my $rs = $schema->resultset("Artist")->search(
+ { artistid => 1 }
+);
+
+my $artist = $rs->first;
+
+ok( !defined($rs->get_cache), 'cache is not populated without cache attribute' );
+
+$rs = $schema->resultset('Artist')->search( undef, { cache => 1 } );
+my $artists = [ $rs->all ];
+
+is( scalar @{$rs->get_cache}, 3, 'all() populates cache for search with cache attribute' );
+
+$rs->clear_cache;
+
+ok( !defined($rs->get_cache), 'clear_cache is functional' );
+
+$rs->next;
+
+is( scalar @{$rs->get_cache}, 3, 'next() populates cache for search with cache attribute' );
+
+pop( @$artists );
+$rs->set_cache( $artists );
+
+is( scalar @{$rs->get_cache}, 2, 'set_cache() is functional' );
+
+my $cd = $schema->resultset('CD')->find(1);
+
+$rs->clear_cache;
+
+$queries = 0;
+$schema->storage->debug(1);
+
+$rs = $schema->resultset('Artist')->search( undef, { cache => 1 } );
+while( $artist = $rs->next ) {}
+$artist = $rs->first();
+
+is( $queries, 1, 'revisiting a row does not issue a query when cache => 1' );
+
+$schema->storage->debug(0);
+
+my @a = $schema->resultset("Artist")->search(
+ { },
+ {
+ join => [ qw/ cds /],
+ prefetch => [qw/ cds /],
+ }
+);
+
+is(scalar @a, 3, 'artist with cds: count parent objects');
+
+$rs = $schema->resultset("Artist")->search(
+ { 'artistid' => 1 },
+ {
+ join => [ qw/ cds /],
+ prefetch => [qw/ cds /],
+ }
+);
+
+use Data::Dumper; $Data::Dumper::Deparse = 1;
+
+# start test for prefetch SELECT count
+$queries = 0;
+$schema->storage->debug(1);
+
+$artist = $rs->first;
+$rs->reset();
+
+# make sure artist contains a related resultset for cds
+is( ref $artist->{related_resultsets}->{cds}, 'DBIx::Class::ResultSet', 'artist has a related_resultset for cds' );
+
+# check if $artist->cds->get_cache is populated
+is( scalar @{$artist->cds->get_cache}, 3, 'cache for artist->cds contains correct number of records');
+
+# ensure that $artist->cds returns correct number of objects
+is( scalar ($artist->cds), 3, 'artist->cds returns correct number of objects' );
+
+# ensure that $artist->cds->count returns correct value
+is( $artist->cds->count, 3, 'artist->cds->count returns correct value' );
+
+# ensure that $artist->count_related('cds') returns correct value
+is( $artist->count_related('cds'), 3, 'artist->count_related returns correct value' );
+
+is($queries, 1, 'only one SQL statement executed');
+
+$schema->storage->debug(0);
+
+# make sure related_resultset is deleted after object is updated
+$artist->set_column('name', 'New Name');
+$artist->update();
+
+is( scalar keys %{$artist->{related_resultsets}}, 0, 'related resultsets deleted after update' );
+
+# todo: make sure caching works with nested prefetch e.g. $artist->cds->tracks
+$rs = $schema->resultset("Artist")->search(
+ { artistid => 1 },
+ {
+ join => { cds => 'tags' },
+ prefetch => {
+ cds => 'tags'
+ },
+ }
+);
+{
+my $artist_count_before = $schema->resultset('Artist')->count;
+$schema->resultset("Artist")->create({artistid=>4,name=>qq{Humoungous Hamsters}});
+is($schema->resultset('Artist')->count, $artist_count_before + 1, 'count() reflects new artist');
+my $artist = $schema->resultset("Artist")->search(
+ { artistid => 4 },{prefetch=>[qw/cds/]}
+)->first;
+
+is($artist->cds, 0, 'No cds for this artist');
+}
+
+# SELECT count for nested has_many prefetch
+$queries = 0;
+$schema->storage->debug(1);
+
+$artist = ($rs->all)[0];
+
+is($queries, 1, 'only one SQL statement executed');
+
+$schema->storage->debug(0);
+
+my @objs;
+#$artist = $rs->find(1);
+
+$queries = 0;
+$schema->storage->debug(1);
+
+my $cds = $artist->cds;
+my $tags = $cds->next->tags;
+while( my $tag = $tags->next ) {
+ push @objs, $tag->tagid; #warn "tag:", $tag->ID, " => ", $tag->tag;
+}
+
+is_deeply( \@objs, [ 3 ], 'first cd has correct tags' );
+
+$tags = $cds->next->tags;
+@objs = ();
+while( my $tag = $tags->next ) {
+ push @objs, $tag->id; #warn "tag: ", $tag->ID;
+}
+
+is_deeply( \@objs, [ 2, 5, 8 ], 'second cd has correct tags' );
+
+is( $queries, 0, 'no additional SQL statements while checking nested data' );
+
+# start test for prefetch SELECT count
+$queries = 0;
+
+$artist = $schema->resultset('Artist')->find(1, { prefetch => [qw/cds/] });
+
+is( $queries, 1, 'only one select statement on find with inline has_many prefetch' );
+
+# start test for prefetch SELECT count
+$queries = 0;
+
+$rs = $schema->resultset('Artist')->search(undef, { prefetch => [qw/cds/] });
+$artist = $rs->find(1);
+
+is( $queries, 1, 'only one select statement on find with has_many prefetch on resultset' );
+
+$schema->storage->debug(0);
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use Storable;
+
+my $schema = DBICTest::init_schema();
+
+plan tests => 1;
+
+my $artist = $schema->resultset('Artist')->find(1);
+my $copy = eval { Storable::dclone($artist) };
+is_deeply($copy, $artist, 'serialize row object works');
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest::init_schema();
+
+eval 'use Encode ; 1'
+ or plan skip_all => 'Install Encode run this test';
+
+plan tests => 2;
+
+DBICTest::Schema::Artist->load_components('UTF8Columns');
+DBICTest::Schema::Artist->utf8_columns('name');
+Class::C3->reinitialize();
+
+my $artist = $schema->resultset("Artist")->create( { name => 'uni' } );
+ok( Encode::is_utf8( $artist->name ), 'got name with utf8 flag' );
+
+my $utf8_char = 'uniuni';
+Encode::_utf8_on($utf8_char);
+$artist->name($utf8_char);
+ok( !Encode::is_utf8( $artist->{_column_data}->{name} ),
+ 'store utf8 less chars' );
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest::init_schema();
+
+my $queries;
+#$schema->storage->debugfh(IO::File->new('t/var/temp.trace', 'w'));
+$schema->storage->debugcb( sub{ $queries++ } );
+
+eval "use DBD::SQLite";
+plan skip_all => 'needs DBD::SQLite for testing' if $@;
+plan tests => 2;
+
+
+my $cd = $schema->resultset("CD")->find(1);
+$cd->title('test');
+
+# SELECT count
+$queries = 0;
+$schema->storage->debug(1);
+
+$cd->update;
+
+is($queries, 1, 'liner_notes (might_have) not prefetched - do not load
+liner_notes on update');
+
+$schema->storage->debug(0);
+
+
+my $cd2 = $schema->resultset("CD")->find(2, {prefetch => 'liner_notes'});
+$cd2->title('test2');
+
+# SELECT count
+$queries = 0;
+$schema->storage->debug(1);
+
+$cd2->update;
+
+is($queries, 1, 'liner_notes (might_have) prefetched - do not load
+liner_notes on update');
+
+$schema->storage->debug(0);
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+eval "use SQL::Translator";
+plan skip_all => 'SQL::Translator required' if $@;
+
+# do not taunt happy dave ball
+
+my $schema = 'DBICTest::Schema';
+
+plan tests => 31;
+
+my $translator = SQL::Translator->new(
+ parser_args => {
+ 'DBIx::Schema' => $schema,
+ },
+ producer_args => {
+ },
+);
+
+$translator->parser('SQL::Translator::Parser::DBIx::Class');
+$translator->producer('SQLite');
+
+my $output = $translator->translate();
+
+my @fk_constraints =
+ (
+ {'display' => 'twokeys->cd',
+ 'selftable' => 'twokeys', 'foreigntable' => 'cd',
+ 'selfcols' => ['cd'], 'foreigncols' => ['cdid'],
+ 'needed' => 1, on_delete => '', on_update => ''},
+ {'display' => 'twokeys->artist',
+ 'selftable' => 'twokeys', 'foreigntable' => 'artist',
+ 'selfcols' => ['artist'], 'foreigncols' => ['artistid'],
+ 'needed' => 1, on_delete => 'CASCADE', on_update => 'CASCADE'},
+ {'display' => 'cd_to_producer->cd',
+ 'selftable' => 'cd_to_producer', 'foreigntable' => 'cd',
+ 'selfcols' => ['cd'], 'foreigncols' => ['cdid'],
+ 'needed' => 1, on_delete => 'CASCADE', on_update => 'CASCADE'},
+ {'display' => 'cd_to_producer->producer',
+ 'selftable' => 'cd_to_producer', 'foreigntable' => 'producer',
+ 'selfcols' => ['producer'], 'foreigncols' => ['producerid'],
+ 'needed' => 1, on_delete => '', on_update => ''},
+ {'display' => 'self_ref_alias -> self_ref for self_ref',
+ 'selftable' => 'self_ref_alias', 'foreigntable' => 'self_ref',
+ 'selfcols' => ['self_ref'], 'foreigncols' => ['id'],
+ 'needed' => 1, on_delete => 'CASCADE', on_update => 'CASCADE'},
+ {'display' => 'self_ref_alias -> self_ref for alias',
+ 'selftable' => 'self_ref_alias', 'foreigntable' => 'self_ref',
+ 'selfcols' => ['alias'], 'foreigncols' => ['id'],
+ 'needed' => 1, on_delete => '', on_update => ''},
+ {'display' => 'cd -> artist',
+ 'selftable' => 'cd', 'foreigntable' => 'artist',
+ 'selfcols' => ['artist'], 'foreigncols' => ['artistid'],
+ 'needed' => 1, on_delete => 'CASCADE', on_update => 'CASCADE'},
+ {'display' => 'artist_undirected_map -> artist for id1',
+ 'selftable' => 'artist_undirected_map', 'foreigntable' => 'artist',
+ 'selfcols' => ['id1'], 'foreigncols' => ['artistid'],
+ 'needed' => 1, on_delete => 'CASCADE', on_update => ''},
+ {'display' => 'artist_undirected_map -> artist for id2',
+ 'selftable' => 'artist_undirected_map', 'foreigntable' => 'artist',
+ 'selfcols' => ['id2'], 'foreigncols' => ['artistid'],
+ 'needed' => 1, on_delete => 'CASCADE', on_update => ''},
+ {'display' => 'track->cd',
+ 'selftable' => 'track', 'foreigntable' => 'cd',
+ 'selfcols' => ['cd'], 'foreigncols' => ['cdid'],
+ 'needed' => 2, on_delete => 'CASCADE', on_update => 'CASCADE'},
+ {'display' => 'treelike -> treelike for parent',
+ 'selftable' => 'treelike', 'foreigntable' => 'treelike',
+ 'selfcols' => ['parent'], 'foreigncols' => ['id'],
+ 'needed' => 1, on_delete => '', on_update => ''},
+
+ # shouldn't this be generated?
+ #
+ #{'display' => 'twokeytreelike -> twokeytreelike for parent1,parent2',
+ # 'selftable' => 'twokeytreelike', 'foreigntable' => 'twokeytreelike',
+ # 'selfcols' => ['parent1', 'parent2'], 'foreigncols' => ['id1','id2'],
+ # 'needed' => 1, on_delete => '', on_update => ''},
+
+ {'display' => 'tags -> cd',
+ 'selftable' => 'tags', 'foreigntable' => 'cd',
+ 'selfcols' => ['cd'], 'foreigncols' => ['cdid'],
+ 'needed' => 1, on_delete => 'CASCADE', on_update => 'CASCADE'},
+ {'display' => 'bookmark -> link',
+ 'selftable' => 'bookmark', 'foreigntable' => 'link',
+ 'selfcols' => ['link'], 'foreigncols' => ['id'],
+ 'needed' => 1, on_delete => '', on_update => ''},
+ );
+
+my @unique_constraints = (
+ {'display' => 'cd artist and title unique',
+ 'table' => 'cd', 'cols' => ['artist', 'title'],
+ 'needed' => 1},
+ {'display' => 'twokeytreelike name unique',
+ 'table' => 'twokeytreelike', 'cols' => ['name'],
+ 'needed' => 1},
+# {'display' => 'employee position and group_id unique',
+# 'table' => 'employee', cols => ['position', 'group_id'],
+# 'needed' => 1},
+);
+
+my $tschema = $translator->schema();
+for my $table ($tschema->get_tables) {
+ my $table_name = $table->name;
+ for my $c ( $table->get_constraints ) {
+ if ($c->type eq 'FOREIGN KEY') {
+ ok(check_fk($table_name, scalar $c->fields,
+ $c->reference_table, scalar $c->reference_fields,
+ $c->on_delete, $c->on_update), "Foreign key constraint on $table_name matches an expected constraint");
+ }
+ elsif ($c->type eq 'UNIQUE') {
+ ok(check_unique($table_name, scalar $c->fields),
+ "Unique constraint on $table_name matches an expected constraint");
+ }
+ }
+}
+
+# Make sure all the foreign keys are done.
+my $i;
+for ($i = 0; $i <= $#fk_constraints; ++$i) {
+ ok(!$fk_constraints[$i]->{'needed'}, "Constraint $fk_constraints[$i]->{display}");
+}
+# Make sure all the uniques are done.
+for ($i = 0; $i <= $#unique_constraints; ++$i) {
+ ok(!$unique_constraints[$i]->{'needed'}, "Constraint $unique_constraints[$i]->{display}");
+}
+
+sub check_fk {
+ my ($selftable, $selfcol, $foreigntable, $foreigncol, $ondel, $onupd) = @_;
+
+ $ondel = '' if (!defined($ondel));
+ $onupd = '' if (!defined($onupd));
+
+ my $i;
+ for ($i = 0; $i <= $#fk_constraints; ++$i) {
+ if ($selftable eq $fk_constraints[$i]->{'selftable'} &&
+ $foreigntable eq $fk_constraints[$i]->{'foreigntable'} &&
+ ($ondel eq $fk_constraints[$i]->{on_delete}) &&
+ ($onupd eq $fk_constraints[$i]->{on_update})) {
+ # check columns
+
+ my $found = 0;
+ for (my $j = 0; $j <= $#$selfcol; ++$j) {
+ $found = 0;
+ for (my $k = 0; $k <= $#{$fk_constraints[$i]->{'selfcols'}}; ++$k) {
+ if ($selfcol->[$j] eq $fk_constraints[$i]->{'selfcols'}->[$k] &&
+ $foreigncol->[$j] eq $fk_constraints[$i]->{'foreigncols'}->[$k]) {
+ $found = 1;
+ last;
+ }
+ }
+ last unless $found;
+ }
+
+ if ($found) {
+ for (my $j = 0; $j <= $#{$fk_constraints[$i]->{'selfcols'}}; ++$j) {
+ $found = 0;
+ for (my $k = 0; $k <= $#$selfcol; ++$k) {
+ if ($selfcol->[$k] eq $fk_constraints[$i]->{'selfcols'}->[$j] &&
+ $foreigncol->[$k] eq $fk_constraints[$i]->{'foreigncols'}->[$j]) {
+ $found = 1;
+ last;
+ }
+ }
+ last unless $found;
+ }
+ }
+
+ if ($found) {
+ --$fk_constraints[$i]->{needed};
+ return 1;
+ }
+ }
+ }
+ return 0;
+}
+
+my( $ondel, $onupd );
+
+sub check_unique {
+ my ($selftable, $selfcol) = @_;
+
+ $ondel = '' if (!defined($ondel));
+ $onupd = '' if (!defined($onupd));
+
+ my $i;
+ for ($i = 0; $i <= $#unique_constraints; ++$i) {
+ if ($selftable eq $unique_constraints[$i]->{'table'}) {
+
+ my $found = 0;
+ for (my $j = 0; $j <= $#$selfcol; ++$j) {
+ $found = 0;
+ for (my $k = 0; $k <= $#{$unique_constraints[$i]->{'cols'}}; ++$k) {
+ if ($selfcol->[$j] eq $unique_constraints[$i]->{'cols'}->[$k]) {
+ $found = 1;
+ last;
+ }
+ }
+ last unless $found;
+ }
+
+ if ($found) {
+ for (my $j = 0; $j <= $#{$unique_constraints[$i]->{'cols'}}; ++$j) {
+ $found = 0;
+ for (my $k = 0; $k <= $#$selfcol; ++$k) {
+ if ($selfcol->[$k] eq $unique_constraints[$i]->{'cols'}->[$j]) {
+ $found = 1;
+ last;
+ }
+ }
+ last unless $found;
+ }
+ }
+
+ if ($found) {
+ --$unique_constraints[$i]->{needed};
+ return 1;
+ }
+ }
+ }
+ return 0;
+}
--- /dev/null
+# vim: filetype=perl
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest::init_schema();
+
+plan tests => 321;
+
+my $employees = $schema->resultset('Employee');
+$employees->delete();
+
+foreach (1..5) {
+ $employees->create({ name=>'temp' });
+}
+$employees = $employees->search(undef,{order_by=>'position'});
+ok( check_rs($employees), "intial positions" );
+
+hammer_rs( $employees );
+
+DBICTest::Employee->grouping_column('group_id');
+$employees->delete();
+foreach my $group_id (1..3) {
+ foreach (1..6) {
+ $employees->create({ name=>'temp', group_id=>$group_id });
+ }
+}
+$employees = $employees->search(undef,{order_by=>'group_id,position'});
+
+foreach my $group_id (1..3) {
+ my $group_employees = $employees->search({group_id=>$group_id});
+ $group_employees->all();
+ ok( check_rs($group_employees), "group intial positions" );
+ hammer_rs( $group_employees );
+}
+
+sub hammer_rs {
+ my $rs = shift;
+ my $employee;
+ my $count = $rs->count();
+ my $position_column = $rs->result_class->position_column();
+ my $row;
+
+ foreach my $position (1..$count) {
+
+ ($row) = $rs->search({ $position_column=>$position })->all();
+ $row->move_previous();
+ ok( check_rs($rs), "move_previous( $position )" );
+
+ ($row) = $rs->search({ $position_column=>$position })->all();
+ $row->move_next();
+ ok( check_rs($rs), "move_next( $position )" );
+
+ ($row) = $rs->search({ $position_column=>$position })->all();
+ $row->move_first();
+ ok( check_rs($rs), "move_first( $position )" );
+
+ ($row) = $rs->search({ $position_column=>$position })->all();
+ $row->move_last();
+ ok( check_rs($rs), "move_last( $position )" );
+
+ foreach my $to_position (1..$count) {
+ ($row) = $rs->search({ $position_column=>$position })->all();
+ $row->move_to($to_position);
+ ok( check_rs($rs), "move_to( $position => $to_position )" );
+ }
+
+ ($row) = $rs->search({ position=>$position })->all();
+ if ($position==1) {
+ ok( !$row->previous_sibling(), 'no previous sibling' );
+ ok( !$row->first_sibling(), 'no first sibling' );
+ }
+ else {
+ ok( $row->previous_sibling(), 'previous sibling' );
+ ok( $row->first_sibling(), 'first sibling' );
+ }
+ if ($position==$count) {
+ ok( !$row->next_sibling(), 'no next sibling' );
+ ok( !$row->last_sibling(), 'no last sibling' );
+ }
+ else {
+ ok( $row->next_sibling(), 'next sibling' );
+ ok( $row->last_sibling(), 'last sibling' );
+ }
+
+ }
+}
+
+sub check_rs {
+ my( $rs ) = @_;
+ $rs->reset();
+ my $position_column = $rs->result_class->position_column();
+ my $expected_position = 0;
+ while (my $row = $rs->next()) {
+ $expected_position ++;
+ if ($row->get_column($position_column)!=$expected_position) {
+ return 0;
+ }
+ }
+ return 1;
+}
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest::init_schema();
+
+plan tests => 8;
+
+my $cd;
+my $rs = $cd = $schema->resultset("CD")->search({});
+
+my $rs_title = $rs->get_column('title');
+my $rs_year = $rs->get_column('year');
+
+is($rs_title->next, 'Spoonful of bees', "next okay");
+
+my @all = $rs_title->all;
+cmp_ok(scalar @all, '==', 5, "five titles returned");
+
+cmp_ok($rs_year->max, '==', 2001, "max okay for year");
+is($rs_title->min, 'Caterwaulin\' Blues', "min okay for title");
+
+cmp_ok($rs_year->sum, '==', 9996, "three artists returned");
+
+my $psrs = $schema->resultset('CD')->search({},
+ {
+ '+select' => \'COUNT(*)',
+ '+as' => 'count'
+ }
+);
+ok(defined($psrs->get_column('count')), '+select/+as count');
+
+$psrs = $schema->resultset('CD')->search({},
+ {
+ '+select' => [ \'COUNT(*)', 'title' ],
+ '+as' => [ 'count', 'addedtitle' ]
+ }
+);
+ok(defined($psrs->get_column('count')), '+select/+as arrayref count');
+ok(defined($psrs->get_column('addedtitle')), '+select/+as title');
+
--- /dev/null
+# vim: filetype=perl
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest::init_schema();
+
+eval 'require JSON';
+plan skip_all => 'Install JSON to run this test' if ($@);
+
+eval 'require Text::CSV_XS';
+if ($@) {
+ eval 'require Text::CSV_PP';
+ plan skip_all => 'Install Text::CSV_XS or Text::CSV_PP to run this test' if ($@);
+}
+
+plan tests => 5;
+
+my $employees = $schema->resultset('Employee');
+my $cmd = qq|script/dbicadmin --schema=DBICTest::Schema --class=Employee --tlibs --connect='["dbi:SQLite:dbname=t/var/DBIxClass.db","",""]' --force --tlibs|;
+
+`$cmd --op=insert --set='{name:"Matt"}'`;
+ok( ($employees->count()==1), 'insert count' );
+
+my $employee = $employees->find(1);
+ok( ($employee->name() eq 'Matt'), 'insert valid' );
+
+`$cmd --op=update --set='{name:"Trout"}'`;
+$employee = $employees->find(1);
+ok( ($employee->name() eq 'Trout'), 'update' );
+
+`$cmd --op=insert --set='{name:"Aran"}'`;
+my $data = `$cmd --op=select --attrs='{order_by:"name"}'`;
+ok( ($data=~/Aran.*Trout/s), 'select with attrs' );
+
+`$cmd --op=delete --where='{name:"Trout"}'`;
+ok( ($employees->count()==1), 'delete' );
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest->init_schema();
+
+eval { require DateTime::Format::MySQL };
+plan skip_all => "Need DateTime::Format::MySQL for inflation tests" if $@;
+
+plan tests => 2;
+
+# inflation test
+my $event = $schema->resultset("Event")->find(1);
+
+isa_ok($event->starts_at, 'DateTime', 'DateTime returned');
+
+is($event->starts_at, '2006-04-25T22:24:33', 'Correct date/time');
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use Class::Inspector;
+
+BEGIN {
+ package TestPackage::A;
+ sub some_method {}
+}
+
+my $schema = DBICTest->init_schema();
+
+plan tests => 6;
+
+ok(Class::Inspector->loaded('TestPackage::A'),
+ 'anon. package exists');
+eval {
+ $schema->ensure_class_loaded('TestPackage::A');
+};
+
+ok(!$@, 'ensure_class_loaded detected an anon. class');
+
+eval {
+ $schema->ensure_class_loaded('FakePackage::B');
+};
+
+like($@, qr/Can't locate/,
+ 'ensure_class_loaded threw exception for nonexistent class');
+
+ok(!Class::Inspector->loaded('DBICTest::FakeComponent'),
+ 'DBICTest::FakeComponent not loaded yet');
+
+eval {
+ $schema->ensure_class_loaded('DBICTest::FakeComponent');
+};
+
+ok(!$@, 'ensure_class_loaded detected an existing but non-loaded class');
+ok(Class::Inspector->loaded('DBICTest::FakeComponent'),
+ 'DBICTest::FakeComponent now loaded');
+
+1;
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest->init_schema();
+
+plan tests => 4;
+
+my $rs1 = $schema->resultset("Artist")->search({ 'tags.tag' => 'Blue' }, { join => {'cds' => 'tracks'}, prefetch => {'cds' => 'tags'} });
+my @artists = $rs1->all;
+cmp_ok(@artists, '==', 1, "Two artists returned");
+
+my $rs2 = $rs1->search({ artistid => '1' }, { join => {'cds' => {'cd_to_producer' => 'producer'} } });
+my $rs3 = $rs2->search_related('cds')->search({'cds.title' => 'Forkful of bees'});
+cmp_ok($rs3->count, '==', 3, "Three artists returned");
+
+my $rs4 = $schema->resultset("CD")->search({ 'artist.artistid' => '1' }, { join => ['tracks', 'artist'], prefetch => 'artist' });
+my @rs4_results = $rs4->all;
+
+
+is($rs4_results[0]->cdid, 1, "correct artist returned");
+
+my $rs5 = $rs4->search({'tracks.title' => 'Sticky Honey'});
+is($rs5->count, 1, "search without using previous joins okay");
+
+1;
use lib 't/lib';
-use_ok('DBICTest::HelperRels');
+use_ok('DBICTest');
+DBICTest::init_schema();
DBICTest::CD->load_components(qw/CDBICompat::Pager/);
use strict;
use warnings;
use DBICTest::Schema;
-use DBICTest::Schema::Relationships;
+
+=head1 NAME
+
+DBICTest - Library to be used by DBIx::Class test scripts.
+
+=head1 SYNOPSIS
+
+ use lib qw(t/lib);
+ use DBICTest;
+ use Test::More;
+
+ my $schema = DBICTest->init_schema();
+
+=head1 DESCRIPTION
+
+This module provides the basic utilities to write tests against
+DBIx::Class.
+
+=head1 METHODS
+
+=head2 init_schema
+
+ my $schema = DBICTest->init_schema(
+ no_deploy=>1,
+ no_populate=>1,
+ );
+
+This method removes the test SQLite database in t/var/DBIxClass.db
+and then creates a new, empty database.
+
+This method will call deploy_schema() by default, unless the
+no_deploy flag is set.
+
+Also, by default, this method will call populate_schema() by
+default, unless the no_deploy or no_populate flags are set.
+
+=cut
sub init_schema {
- my $db_file = "t/var/DBIxClass.db";
+ my $self = shift;
+ my %args = @_;
+ my $db_file = "t/var/DBIxClass.db";
+
+ unlink($db_file) if -e $db_file;
+ unlink($db_file . "-journal") if -e $db_file . "-journal";
+ mkdir("t/var") unless -d "t/var";
+
+ my $dsn = $ENV{"DBICTEST_DSN"} || "dbi:SQLite:${db_file}";
+ my $dbuser = $ENV{"DBICTEST_DBUSER"} || '';
+ my $dbpass = $ENV{"DBICTEST_DBPASS"} || '';
+
+ my $schema = DBICTest::Schema->compose_connection('DBICTest' => $dsn, $dbuser, $dbpass);
+ if ( !$args{no_deploy} ) {
+ __PACKAGE__->deploy_schema( $schema );
+ __PACKAGE__->populate_schema( $schema ) if( !$args{no_populate} );
+ }
+ return $schema;
+}
+
+=head2 deploy_schema
+
+ DBICTest->deploy_schema( $schema );
+
+This method does one of two things to the schema. It can either call
+the experimental $schema->deploy() if the DBICTEST_SQLT_DEPLOY environment
+variable is set, otherwise the default is to read in the t/lib/sqlite.sql
+file and execute the SQL within. Either way you end up with a fresh set
+of tables for testing.
+
+=cut
+
+sub deploy_schema {
+ my $self = shift;
+ my $schema = shift;
+
+ if ($ENV{"DBICTEST_SQLT_DEPLOY"}) {
+ return $schema->deploy();
+ } else {
+ open IN, "t/lib/sqlite.sql";
+ my $sql;
+ { local $/ = undef; $sql = <IN>; }
+ close IN;
+ $schema->storage->dbh->do($_) for split(/;\n/, $sql);
+ }
+}
+
+=head2 populate_schema
+
+ DBICTest->populate_schema( $schema );
+
+After you deploy your schema you can use this method to populate
+the tables with test data.
+
+=cut
+
+sub populate_schema {
+ my $self = shift;
+ my $schema = shift;
+
+ $schema->storage->dbh->do("PRAGMA synchronous = OFF");
+
+ $schema->populate('Artist', [
+ [ qw/artistid name/ ],
+ [ 1, 'Caterwauler McCrae' ],
+ [ 2, 'Random Boy Band' ],
+ [ 3, 'We Are Goth' ],
+ ]);
+
+ $schema->populate('CD', [
+ [ qw/cdid artist title year/ ],
+ [ 1, 1, "Spoonful of bees", 1999 ],
+ [ 2, 1, "Forkful of bees", 2001 ],
+ [ 3, 1, "Caterwaulin' Blues", 1997 ],
+ [ 4, 2, "Generic Manufactured Singles", 2001 ],
+ [ 5, 3, "Come Be Depressed With Us", 1998 ],
+ ]);
+
+ $schema->populate('LinerNotes', [
+ [ qw/liner_id notes/ ],
+ [ 2, "Buy Whiskey!" ],
+ [ 4, "Buy Merch!" ],
+ [ 5, "Kill Yourself!" ],
+ ]);
+
+ $schema->populate('Tag', [
+ [ qw/tagid cd tag/ ],
+ [ 1, 1, "Blue" ],
+ [ 2, 2, "Blue" ],
+ [ 3, 3, "Blue" ],
+ [ 4, 5, "Blue" ],
+ [ 5, 2, "Cheesy" ],
+ [ 6, 4, "Cheesy" ],
+ [ 7, 5, "Cheesy" ],
+ [ 8, 2, "Shiny" ],
+ [ 9, 4, "Shiny" ],
+ ]);
+
+ $schema->populate('TwoKeys', [
+ [ qw/artist cd/ ],
+ [ 1, 1 ],
+ [ 1, 2 ],
+ [ 2, 2 ],
+ ]);
+
+ $schema->populate('FourKeys', [
+ [ qw/foo bar hello goodbye/ ],
+ [ 1, 2, 3, 4 ],
+ [ 5, 4, 3, 6 ],
+ ]);
+
+ $schema->populate('OneKey', [
+ [ qw/id artist cd/ ],
+ [ 1, 1, 1 ],
+ [ 2, 1, 2 ],
+ [ 3, 2, 2 ],
+ ]);
+
+ $schema->populate('SelfRef', [
+ [ qw/id name/ ],
+ [ 1, 'First' ],
+ [ 2, 'Second' ],
+ ]);
+
+ $schema->populate('SelfRefAlias', [
+ [ qw/self_ref alias/ ],
+ [ 1, 2 ]
+ ]);
+
+ $schema->populate('ArtistUndirectedMap', [
+ [ qw/id1 id2/ ],
+ [ 1, 2 ]
+ ]);
+
+ $schema->populate('Producer', [
+ [ qw/producerid name/ ],
+ [ 1, 'Matt S Trout' ],
+ [ 2, 'Bob The Builder' ],
+ [ 3, 'Fred The Phenotype' ],
+ ]);
+
+ $schema->populate('CD_to_Producer', [
+ [ qw/cd producer/ ],
+ [ 1, 1 ],
+ [ 1, 2 ],
+ [ 1, 3 ],
+ ]);
+
+ $schema->populate('TreeLike', [
+ [ qw/id parent name/ ],
+ [ 1, 0, 'foo' ],
+ [ 2, 1, 'bar' ],
+ [ 3, 2, 'baz' ],
+ [ 4, 3, 'quux' ],
+ ]);
+
+ $schema->populate('Track', [
+ [ qw/trackid cd position title/ ],
+ [ 4, 2, 1, "Stung with Success"],
+ [ 5, 2, 2, "Stripy"],
+ [ 6, 2, 3, "Sticky Honey"],
+ [ 7, 3, 1, "Yowlin"],
+ [ 8, 3, 2, "Howlin"],
+ [ 9, 3, 3, "Fowlin"],
+ [ 10, 4, 1, "Boring Name"],
+ [ 11, 4, 2, "Boring Song"],
+ [ 12, 4, 3, "No More Ideas"],
+ [ 13, 5, 1, "Sad"],
+ [ 14, 5, 2, "Under The Weather"],
+ [ 15, 5, 3, "Suicidal"],
+ [ 16, 1, 1, "The Bees Knees"],
+ [ 17, 1, 2, "Apiary"],
+ [ 18, 1, 3, "Beehind You"],
+ ]);
- unlink($db_file) if -e $db_file;
- unlink($db_file . "-journal") if -e $db_file . "-journal";
- mkdir("t/var") unless -d "t/var";
+ $schema->populate('Event', [
+ [ qw/id starts_at/ ],
+ [ 1, '2006-04-25 22:24:33' ],
+ ]);
- my $dsn = $ENV{"DBICTEST_DSN"} || "dbi:SQLite:${db_file}";
- my $dbuser = $ENV{"DBICTEST_DBUSER"} || '';
- my $dbpass = $ENV{"DBICTEST_DBPASS"} || '';
+ $schema->populate('Link', [
+ [ qw/id title/ ],
+ [ 1, 'aaa' ]
+ ]);
- my $schema = DBICTest::Schema->compose_connection('DBICTest' => $dsn, $dbuser, $dbpass);
- $schema->deploy();
- $schema->auto_populate();
- return $schema;
+ $schema->populate('Bookmark', [
+ [ qw/id link/ ],
+ [ 1, 1 ]
+ ]);
}
1;
qw/SelfRefAlias TreeLike TwoKeyTreeLike Event/
);
-sub deploy {
- my $self = shift;
-
- if ($ENV{"DBICTEST_SQLT_DEPLOY"}) {
- return $schema->next::method(@_);
- } else {
- open IN, "t/lib/sqlite.sql";
- my $sql;
- { local $/ = undef; $sql = <IN>; }
- close IN;
- $self->storage->dbh->do($_) for split(/;\n/, $sql);
- }
-}
-
-sub auto_populate {
- my $self = shift;
-
- $self->storage->dbh->do("PRAGMA synchronous = OFF");
-
- $self->populate('Artist', [
- [ qw/artistid name/ ],
- [ 1, 'Caterwauler McCrae' ],
- [ 2, 'Random Boy Band' ],
- [ 3, 'We Are Goth' ],
- ]);
-
- $self->populate('CD', [
- [ qw/cdid artist title year/ ],
- [ 1, 1, "Spoonful of bees", 1999 ],
- [ 2, 1, "Forkful of bees", 2001 ],
- [ 3, 1, "Caterwaulin' Blues", 1997 ],
- [ 4, 2, "Generic Manufactured Singles", 2001 ],
- [ 5, 3, "Come Be Depressed With Us", 1998 ],
- ]);
-
- $self->populate('LinerNotes', [
- [ qw/liner_id notes/ ],
- [ 2, "Buy Whiskey!" ],
- [ 4, "Buy Merch!" ],
- [ 5, "Kill Yourself!" ],
- ]);
-
- $self->populate('Tag', [
- [ qw/tagid cd tag/ ],
- [ 1, 1, "Blue" ],
- [ 2, 2, "Blue" ],
- [ 3, 3, "Blue" ],
- [ 4, 5, "Blue" ],
- [ 5, 2, "Cheesy" ],
- [ 6, 4, "Cheesy" ],
- [ 7, 5, "Cheesy" ],
- [ 8, 2, "Shiny" ],
- [ 9, 4, "Shiny" ],
- ]);
-
- $self->populate('TwoKeys', [
- [ qw/artist cd/ ],
- [ 1, 1 ],
- [ 1, 2 ],
- [ 2, 2 ],
- ]);
-
- $self->populate('FourKeys', [
- [ qw/foo bar hello goodbye/ ],
- [ 1, 2, 3, 4 ],
- [ 5, 4, 3, 6 ],
- ]);
-
- $self->populate('OneKey', [
- [ qw/id artist cd/ ],
- [ 1, 1, 1 ],
- [ 2, 1, 2 ],
- [ 3, 2, 2 ],
- ]);
-
- $self->populate('SelfRef', [
- [ qw/id name/ ],
- [ 1, 'First' ],
- [ 2, 'Second' ],
- ]);
-
- $self->populate('SelfRefAlias', [
- [ qw/self_ref alias/ ],
- [ 1, 2 ]
- ]);
-
- $self->populate('ArtistUndirectedMap', [
- [ qw/id1 id2/ ],
- [ 1, 2 ]
- ]);
-
- $self->populate('Producer', [
- [ qw/producerid name/ ],
- [ 1, 'Matt S Trout' ],
- [ 2, 'Bob The Builder' ],
- [ 3, 'Fred The Phenotype' ],
- ]);
-
- $self->populate('CD_to_Producer', [
- [ qw/cd producer/ ],
- [ 1, 1 ],
- [ 1, 2 ],
- [ 1, 3 ],
- ]);
-
- $self->populate('TreeLike', [
- [ qw/id parent name/ ],
- [ 1, 0, 'foo' ],
- [ 2, 1, 'bar' ],
- [ 3, 2, 'baz' ],
- [ 4, 3, 'quux' ],
- ]);
-
- $self->populate('Track', [
- [ qw/trackid cd position title/ ],
- [ 4, 2, 1, "Stung with Success"],
- [ 5, 2, 2, "Stripy"],
- [ 6, 2, 3, "Sticky Honey"],
- [ 7, 3, 1, "Yowlin"],
- [ 8, 3, 2, "Howlin"],
- [ 9, 3, 3, "Fowlin"],
- [ 10, 4, 1, "Boring Name"],
- [ 11, 4, 2, "Boring Song"],
- [ 12, 4, 3, "No More Ideas"],
- [ 13, 5, 1, "Sad"],
- [ 14, 5, 2, "Under The Weather"],
- [ 15, 5, 3, "Suicidal"],
- [ 16, 1, 1, "The Bees Knees"],
- [ 17, 1, 2, "Apiary"],
- [ 18, 1, 3, "Beehind You"],
- ]);
-
- $self->populate('Link', [
- [ qw/id title/ ],
- [ 1, 'aaa' ]
- ]);
-
- $self->populate('Bookmark', [
- [ qw/id link/ ],
- [ 1, 1 ]
- ]);
-}
-
1;
use base 'DBIx::Class::Core';
-__PACKAGE__->load_components('PK::Auto');
-
-DBICTest::Schema::Artist->table('artist');
-DBICTest::Schema::Artist->add_columns(
+__PACKAGE__->table('artist');
+__PACKAGE__->add_columns(
'artistid' => {
data_type => 'integer',
is_auto_increment => 1
is_nullable => 1,
},
);
-DBICTest::Schema::Artist->set_primary_key('artistid');
+__PACKAGE__->set_primary_key('artistid');
__PACKAGE__->mk_classdata('field_name_for', {
artistid => 'primary key',
name => 'artist name',
});
+__PACKAGE__->has_many(
+ cds => 'DBICTest::Schema::CD', undef,
+ { order_by => 'year' },
+);
+
+__PACKAGE__->has_many( twokeys => 'DBICTest::Schema::TwoKeys' );
+__PACKAGE__->has_many( onekeys => 'DBICTest::Schema::OneKey' );
+
+__PACKAGE__->has_many(
+ artist_undirected_maps => 'DBICTest::Schema::ArtistUndirectedMap',
+ [ {'foreign.id1' => 'self.artistid'}, {'foreign.id2' => 'self.artistid'} ],
+ { cascade_copy => 0 } # this would *so* not make sense
+);
+
1;
);
__PACKAGE__->set_primary_key(qw/id1 id2/);
+__PACKAGE__->belongs_to( 'artist1', 'DBICTest::Schema::Artist', 'id1' );
+__PACKAGE__->belongs_to( 'artist2', 'DBICTest::Schema::Artist', 'id2');
+__PACKAGE__->has_many(
+ 'mapped_artists', 'DBICTest::Schema::Artist',
+ [ {'foreign.artistid' => 'self.id1'}, {'foreign.artistid' => 'self.id2'} ],
+);
+
1;
use strict;
use warnings;
-__PACKAGE__->load_components(qw/PK::Auto Core/);
__PACKAGE__->table('bookmark');
__PACKAGE__->add_columns(qw/id link/);
__PACKAGE__->add_columns(
use base 'DBIx::Class::Core';
-__PACKAGE__->load_components('PK::Auto');
-
-DBICTest::Schema::CD->table('cd');
-DBICTest::Schema::CD->add_columns(
+__PACKAGE__->table('cd');
+__PACKAGE__->add_columns(
'cdid' => {
data_type => 'integer',
is_auto_increment => 1,
size => 100,
},
);
-DBICTest::Schema::CD->set_primary_key('cdid');
-DBICTest::Schema::CD->add_unique_constraint(artist_title => [ qw/artist title/ ]);
+__PACKAGE__->set_primary_key('cdid');
+__PACKAGE__->add_unique_constraint(artist_title => [ qw/artist title/ ]);
+
+__PACKAGE__->belongs_to( artist => 'DBICTest::Schema::Artist' );
+
+__PACKAGE__->has_many( tracks => 'DBICTest::Schema::Track' );
+__PACKAGE__->has_many(
+ tags => 'DBICTest::Schema::Tag', undef,
+ { order_by => 'tag' },
+);
+__PACKAGE__->has_many(
+ cd_to_producer => 'DBICTest::Schema::CD_to_Producer' => 'cd'
+);
+
+__PACKAGE__->might_have(
+ liner_notes => 'DBICTest::Schema::LinerNotes', undef,
+ { proxy => [ qw/notes/ ] },
+);
+__PACKAGE__->many_to_many( producers => cd_to_producer => 'producer' );
+__PACKAGE__->many_to_many(
+ producers_sorted => cd_to_producer => 'producer',
+ { order_by => 'producer.name' },
+);
1;
);
__PACKAGE__->set_primary_key(qw/cd producer/);
+__PACKAGE__->belongs_to(
+ 'cd', 'DBICTest::Schema::CD',
+ { 'foreign.cdid' => 'self.cd' }
+);
+
+__PACKAGE__->belongs_to(
+ 'producer', 'DBICTest::Schema::Producer',
+ { 'foreign.producerid' => 'self.producer' }
+);
+
1;
package # hide from PAUSE
DBICTest::Schema::Employee;
-use base 'DBIx::Class';
+use base 'DBIx::Class::Core';
-__PACKAGE__->load_components(qw( Ordered PK::Auto Core ));
+__PACKAGE__->load_components(qw( Ordered ));
__PACKAGE__->table('employee');
use strict;
use warnings;
-use base qw/DBIx::Class/;
+use base qw/DBIx::Class::Core/;
-__PACKAGE__->load_components(qw/InflateColumn::DateTime PK::Auto Core/);
+__PACKAGE__->load_components(qw/InflateColumn::DateTime/);
__PACKAGE__->table('event');
use strict;
use warnings;
-__PACKAGE__->load_components(qw/PK::Auto Core/);
__PACKAGE__->table('link');
__PACKAGE__->add_columns(
'id' => {
use base 'DBIx::Class::Core';
-__PACKAGE__->load_components('PK::Auto');
-
DBICTest::Schema::OneKey->table('onekey');
DBICTest::Schema::OneKey->add_columns(
'id' => {
+++ /dev/null
-package # hide from PAUSE
- DBICTest::Schema::Relationships;
-
-use base 'DBIx::Class::Core';
-
-DBICTest::Schema::Artist->has_many(cds => 'DBICTest::Schema::CD', undef,
- { order_by => 'year' });
-DBICTest::Schema::Artist->has_many(twokeys => 'DBICTest::Schema::TwoKeys');
-DBICTest::Schema::Artist->has_many(onekeys => 'DBICTest::Schema::OneKey');
-
-DBICTest::Schema::CD->belongs_to('artist', 'DBICTest::Schema::Artist');
-
-DBICTest::Schema::CD->has_many(tracks => 'DBICTest::Schema::Track');
-DBICTest::Schema::CD->has_many(tags => 'DBICTest::Schema::Tag', undef,
- { order_by => 'tag' });
-DBICTest::Schema::CD->has_many(cd_to_producer => 'DBICTest::Schema::CD_to_Producer' => 'cd');
-
-DBICTest::Schema::CD->might_have(liner_notes => 'DBICTest::Schema::LinerNotes',
- undef, { proxy => [ qw/notes/ ] });
-
-DBICTest::Schema::SelfRefAlias->belongs_to(
- self_ref => 'DBICTest::Schema::SelfRef');
-DBICTest::Schema::SelfRefAlias->belongs_to(
- alias => 'DBICTest::Schema::SelfRef');
-
-DBICTest::Schema::SelfRef->has_many(
- aliases => 'DBICTest::Schema::SelfRefAlias' => 'self_ref');
-
-DBICTest::Schema::Tag->belongs_to('cd', 'DBICTest::Schema::CD');
-
-DBICTest::Schema::Track->belongs_to('cd', 'DBICTest::Schema::CD');
-DBICTest::Schema::Track->belongs_to('disc', 'DBICTest::Schema::CD', 'cd');
-
-DBICTest::Schema::TwoKeys->belongs_to('artist', 'DBICTest::Schema::Artist');
-DBICTest::Schema::TwoKeys->belongs_to('cd', 'DBICTest::Schema::CD');
-
-DBICTest::Schema::CD_to_Producer->belongs_to(
- 'cd', 'DBICTest::Schema::CD',
- { 'foreign.cdid' => 'self.cd' }
-);
-DBICTest::Schema::CD_to_Producer->belongs_to(
- 'producer', 'DBICTest::Schema::Producer',
- { 'foreign.producerid' => 'self.producer' }
-);
-DBICTest::Schema::Artist->has_many(
- 'artist_undirected_maps', 'DBICTest::Schema::ArtistUndirectedMap',
- [{'foreign.id1' => 'self.artistid'}, {'foreign.id2' => 'self.artistid'}],
- { cascade_copy => 0 } # this would *so* not make sense
-);
-DBICTest::Schema::ArtistUndirectedMap->belongs_to(
- 'artist1', 'DBICTest::Schema::Artist', 'id1');
-DBICTest::Schema::ArtistUndirectedMap->belongs_to(
- 'artist2', 'DBICTest::Schema::Artist', 'id2');
-DBICTest::Schema::ArtistUndirectedMap->has_many(
- 'mapped_artists', 'DBICTest::Schema::Artist',
- [{'foreign.artistid' => 'self.id1'}, {'foreign.artistid' => 'self.id2'}]);
-
-# now the Helpers
-DBICTest::Schema::CD->many_to_many( 'producers', 'cd_to_producer', 'producer');
-DBICTest::Schema::CD->many_to_many( 'producers_sorted', 'cd_to_producer', 'producer', { order_by => 'producer.name' });
-
-1;
);\r
__PACKAGE__->set_primary_key('id');\r
\r
+__PACKAGE__->has_many( aliases => 'DBICTest::Schema::SelfRefAlias' => 'self_ref' );\r
+\r
1;\r
);\r
__PACKAGE__->set_primary_key(qw/self_ref alias/);\r
\r
+__PACKAGE__->belongs_to( self_ref => 'DBICTest::Schema::SelfRef' );\r
+__PACKAGE__->belongs_to( alias => 'DBICTest::Schema::SelfRef' );\r
+\r
1;\r
use base qw/DBIx::Class::Core/;
-__PACKAGE__->load_components('PK::Auto');
-
-DBICTest::Schema::Tag->table('tags');
-DBICTest::Schema::Tag->add_columns(
+__PACKAGE__->table('tags');
+__PACKAGE__->add_columns(
'tagid' => {
data_type => 'integer',
is_auto_increment => 1,
size => 100,
},
);
-DBICTest::Schema::Tag->set_primary_key('tagid');
+__PACKAGE__->set_primary_key('tagid');
+
+__PACKAGE__->belongs_to( cd => 'DBICTest::Schema::CD' );
1;
use base 'DBIx::Class::Core';
-DBICTest::Schema::Track->table('track');
-DBICTest::Schema::Track->add_columns(
+__PACKAGE__->table('track');
+__PACKAGE__->add_columns(
'trackid' => {
data_type => 'integer',
is_auto_increment => 1,
size => 100,
},
);
-DBICTest::Schema::Track->set_primary_key('trackid');
+__PACKAGE__->set_primary_key('trackid');
+
+__PACKAGE__->belongs_to( cd => 'DBICTest::Schema::CD' );
+__PACKAGE__->belongs_to( disc => 'DBICTest::Schema::CD' => 'cd');
1;
package # hide from PAUSE
DBICTest::Schema::TreeLike;
-use base qw/DBIx::Class/;
-
-__PACKAGE__->load_components(qw/PK::Auto::SQLite Core/);
+use base qw/DBIx::Class::Core/;
__PACKAGE__->table('treelike');
__PACKAGE__->add_columns(
package # hide from PAUSE
DBICTest::Schema::TwoKeyTreeLike;
-use base qw/DBIx::Class/;
-
-__PACKAGE__->load_components(qw/Core/);
+use base qw/DBIx::Class::Core/;
__PACKAGE__->table('twokeytreelike');
__PACKAGE__->add_columns(
use base 'DBIx::Class::Core';
-DBICTest::Schema::TwoKeys->table('twokeys');
-DBICTest::Schema::TwoKeys->add_columns(
+__PACKAGE__->table('twokeys');
+__PACKAGE__->add_columns(
'artist' => { data_type => 'integer' },
'cd' => { data_type => 'integer' },
);
-DBICTest::Schema::TwoKeys->set_primary_key(qw/artist cd/);
+__PACKAGE__->set_primary_key(qw/artist cd/);
+
+__PACKAGE__->belongs_to( artist => 'DBICTest::Schema::Artist' );
+__PACKAGE__->belongs_to( cd => 'DBICTest::Schema::CD' );
1;