use warnings;
sub has_one {
- my ($class, $acc_name, $f_class, $conds, $args) = @_;
+ my ($class, $acc_name, $f_class, $cond) = @_;
eval "require $f_class";
# single key relationship
- if (not defined $conds && not defined $args) {
+ if (not defined $cond) {
my ($pri, $too_many) = keys %{ $f_class->_primaries };
my $acc_type = ($class->_columns->{$acc_name}) ? 'filter' : 'single';
$class->add_relationship($acc_name, $f_class,
# multiple key relationship
else {
my %f_primaries = %{ $f_class->_primaries };
- my $conds_rel;
- for (keys %$conds) {
- $conds_rel->{"foreign.$_"} = "self.".$conds->{$_};
+ my $cond_rel;
+ for (keys %$cond) {
+ $cond_rel->{"foreign.$_"} = "self.".$cond->{$_};
# primary key usage checks
if (exists $f_primaries{$_}) {
delete $f_primaries{$_};
}
$class->throw("not all primary keys used in multi key relationship!") if keys %f_primaries;
$class->add_relationship($acc_name, $f_class,
- $conds_rel,
+ $cond_rel,
{ accessor => 'single' }
);
}
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::BasicRels;
+
+require "t/run/01core.tl";
+run_tests();
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::BasicRels;
+
+require "t/run/04db.tl";
+run_tests();
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::BasicRels;
+
+require "t/run/05multipk.tl";
+run_tests();
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::BasicRels;
+
+require "t/run/06relationship.tl";
+run_tests();
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::BasicRels;
+
+require "t/run/07pager.tl";
+run_tests();
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::BasicRels;
+
+require "t/run/08inflate.tl";
+run_tests();
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::BasicRels;
+
+require "t/run/08inflate_has_a.tl";
+run_tests();
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::BasicRels;
+
+require "t/run/09update.tl";
+run_tests();
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::BasicRels;
+
+require "t/run/10auto.tl";
+run_tests();
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::BasicRels;
+
+require "t/run/11mysql.tl";
+run_tests();
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::BasicRels;
+
+require "t/run/12pg.tl";
+run_tests();
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::BasicRels;
+
+require "t/run/13oracle.tl";
+run_tests();
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::BasicRels;
+
+require "t/run/14mssql.tl";
+run_tests();
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::BasicRels;
+
+require "t/run/15limit.tl";
+run_tests();
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::BasicRels;
+
+require "t/run/16joins.tl";
+run_tests();
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::BasicRels;
+
+require "t/run/17join_count.tl";
+run_tests();
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::BasicRels;
+
+require "t/run/18self_referencial.tl";
+run_tests();
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::HelperRels;
+
+require "t/run/01core.tl";
+run_tests();
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::HelperRels;
+
+require "t/run/04db.tl";
+run_tests();
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::HelperRels;
+
+require "t/run/05multipk.tl";
+run_tests();
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::HelperRels;
+
+require "t/run/06relationship.tl";
+run_tests();
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::HelperRels;
+
+require "t/run/07pager.tl";
+run_tests();
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::HelperRels;
+
+require "t/run/08inflate.tl";
+run_tests();
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::HelperRels;
+
+require "t/run/08inflate_has_a.tl";
+run_tests();
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::HelperRels;
+
+require "t/run/09update.tl";
+run_tests();
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::HelperRels;
+
+require "t/run/10auto.tl";
+run_tests();
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::HelperRels;
+
+require "t/run/11mysql.tl";
+run_tests();
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::HelperRels;
+
+require "t/run/12pg.tl";
+run_tests();
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::HelperRels;
+
+require "t/run/13oracle.tl";
+run_tests();
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::HelperRels;
+
+require "t/run/14mssql.tl";
+run_tests();
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::HelperRels;
+
+require "t/run/15limit.tl";
+run_tests();
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::HelperRels;
+
+require "t/run/16joins.tl";
+run_tests();
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::HelperRels;
+
+require "t/run/17join_count.tl";
+run_tests();
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::HelperRels;
+
+require "t/run/18self_referencial.tl";
+run_tests();
--- /dev/null
+package DBICTest::BasicRels;
+
+use DBICTest::Schema;
+use DBICTest::Schema::BasicRels;
+
+1;
--- /dev/null
+package DBICTest::HelperRels;
+
+use DBICTest::Schema;
+use DBICTest::Schema::HelperRels;
+
+1;
--- /dev/null
+package DBICTest::Schema::BasicRels;
+
+use base 'DBIx::Class::Core';
+
+DBICTest::Schema::Artist->add_relationship(
+ cds => 'DBICTest::Schema::CD',
+ { 'foreign.artist' => 'self.artistid' },
+ { order_by => 'year' }
+);
+DBICTest::Schema::Artist->add_relationship(
+ twokeys => 'DBICTest::Schema::TwoKeys',
+ { 'foreign.artist' => 'self.artistid' }
+);
+DBICTest::Schema::Artist->add_relationship(
+ onekeys => 'DBICTest::Schema::OneKey',
+ { 'foreign.artist' => 'self.artistid' }
+);
+
+DBICTest::Schema::CD->add_relationship(
+ artist => 'DBICTest::Schema::Artist',
+ { 'foreign.artistid' => 'self.artist' },
+);
+DBICTest::Schema::CD->add_relationship(
+ tracks => 'DBICTest::Schema::Track',
+ { 'foreign.cd' => 'self.cdid' }
+);
+DBICTest::Schema::CD->add_relationship(
+ tags => 'DBICTest::Schema::Tag',
+ { 'foreign.cd' => 'self.cdid' }
+);
+#DBICTest::Schema::CD->might_have(liner_notes => 'DBICTest::Schema::LinerNotes' => qw/notes/);
+DBICTest::Schema::CD->add_relationship(
+ liner_notes => 'DBICTest::Schema::LinerNotes',
+ { 'foreign.liner_id' => 'self.cdid' },
+ { join_type => 'LEFT' }
+);
+
+
+DBICTest::Schema::SelfRefAlias->add_relationship(
+ self_ref => 'DBICTest::Schema::SelfRef',
+ { 'foreign.id' => 'self.self_ref' },
+ { accessor => 'single' }
+
+);
+DBICTest::Schema::SelfRefAlias->add_relationship(
+ alias => 'DBICTest::Schema::SelfRef',
+ { 'foreign.id' => 'self.alias' },
+ { accessor => 'single' }
+);
+
+DBICTest::Schema::SelfRef->add_relationship(
+ aliases => 'DBICTest::Schema::SelfRefAlias',
+ { 'foreign.self_ref' => 'self.id' },
+ { accessor => 'multi' }
+);
+
+DBICTest::Schema::Tag->add_relationship(
+ cd => 'DBICTest::Schema::CD',
+ { 'foreign.cdid' => 'self.cd' }
+);
+
+DBICTest::Schema::Track->add_relationship(
+ cd => 'DBICTest::Schema::CD',
+ { 'foreign.cdid' => 'self.cd' }
+);
+
+DBICTest::Schema::TwoKeys->add_relationship(
+ artist => 'DBICTest::Schema::Artist',
+ { 'foreign.artistid' => 'self.artist' }
+);
+DBICTest::Schema::TwoKeys->add_relationship(
+ cd => 'DBICTest::Schema::CD',
+ { 'foreign.cdid' => 'self.cd' }
+);
+
+1;
--- /dev/null
+package DBICTest::Schema::BasicRels;
+
+use base 'DBIx::Class::Core';
+
+DBICTest::Schema::Artist->add_relationship(
+ cds => 'DBICTest::Schema::CD',
+ { 'foreign.artist' => 'self.artistid' },
+ { order_by => 'year' }
+);
+DBICTest::Schema::Artist->add_relationship(
+ twokeys => 'DBICTest::Schema::TwoKeys',
+ { 'foreign.artist' => 'self.artistid' }
+);
+DBICTest::Schema::Artist->add_relationship(
+ onekeys => 'DBICTest::Schema::OneKey',
+ { 'foreign.artist' => 'self.artistid' }
+);
+
+DBICTest::Schema::CD->has_one('artist', 'DBICTest::Schema::Artist');
+#DBICTest::Schema::CD->add_relationship(
+# artist => 'DBICTest::Schema::Artist',
+# { 'foreign.artistid' => 'self.artist' },
+#);
+DBICTest::Schema::CD->add_relationship(
+ tracks => 'DBICTest::Schema::Track',
+ { 'foreign.cd' => 'self.cdid' }
+);
+DBICTest::Schema::CD->add_relationship(
+ tags => 'DBICTest::Schema::Tag',
+ { 'foreign.cd' => 'self.cdid' }
+);
+#DBICTest::Schema::CD->might_have(liner_notes => 'DBICTest::Schema::LinerNotes' => qw/notes/);
+DBICTest::Schema::CD->add_relationship(
+ liner_notes => 'DBICTest::Schema::LinerNotes',
+ { 'foreign.liner_id' => 'self.cdid' },
+ { join_type => 'LEFT' }
+);
+
+DBICTest::Schema::SelfRefAlias->add_relationship(
+ self_ref => 'DBICTest::Schema::SelfRef',
+ { 'foreign.id' => 'self.self_ref' },
+ { accessor => 'single' }
+
+);
+DBICTest::Schema::SelfRefAlias->add_relationship(
+ alias => 'DBICTest::Schema::SelfRef',
+ { 'foreign.id' => 'self.alias' },
+ { accessor => 'single' }
+);
+
+DBICTest::Schema::SelfRef->add_relationship(
+ aliases => 'DBICTest::Schema::SelfRefAlias',
+ { 'foreign.self_ref' => 'self.id' },
+ { accessor => 'multi' }
+);
+
+DBICTest::Schema::Tag->has_one('cd', 'DBICTest::Schema::CD');
+#DBICTest::Schema::Tag->add_relationship(
+# cd => 'DBICTest::Schema::CD',
+# { 'foreign.cdid' => 'self.cd' }
+#);
+
+DBICTest::Schema::Track->has_one('cd', 'DBICTest::Schema::CD');
+#DBICTest::Schema::Track->add_relationship(
+# cd => 'DBICTest::Schema::CD',
+# { 'foreign.cdid' => 'self.cd' }
+#);
+
+DBICTest::Schema::TwoKeys->has_one('artist', 'DBICTest::Schema::Artist');
+# DBICTest::Schema::TwoKeys->add_relationship(
+# artist => 'DBICTest::Schema::Artist',
+# { 'foreign.artistid' => 'self.artist' }
+# );
+DBICTest::Schema::TwoKeys->has_one('cd', 'DBICTest::Schema::CD');
+#DBICTest::Schema::TwoKeys->add_relationship(
+# cd => 'DBICTest::Schema::CD',
+# { 'foreign.cdid' => 'self.cd' }
+#);
+
+1;
--- /dev/null
+sub run_tests {
+
+plan tests => 22;
+
+my @art = DBICTest::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');
+
+@art = DBICTest::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 = DBICTest::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 = DBICTest::Artist->search({ });
+
+cmp_ok(@art, '==', 3, 'And now there are three again');
+
+my $new = DBICTest::Artist->create({ artistid => 4 });
+
+cmp_ok($new->artistid, '==', 4, 'Create produced record ok');
+
+@art = DBICTest::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;
+
+$new_again = DBICTest::Artist->find(4);
+
+is($new_again->name, 'Man With A Spoon', 'Retrieved correctly');
+
+is(DBICTest::Artist->count, 4, 'count ok');
+
+# insert_or_update
+$new = DBICTest::Track->new( {
+ trackid => 100,
+ cd => 1,
+ position => 1,
+ title => 'Insert or Update',
+} );
+$new->insert_or_update;
+ok($new->in_storage, 'insert_or_update insert ok');
+
+# test in update mode
+$new->position(5);
+$new->insert_or_update;
+is( DBICTest::Track->find(100)->position, 5, 'insert_or_update update ok');
+
+eval { DBICTest::Track->load_components('DoesNotExist'); };
+
+ok $@, $@;
+
+}
+
+1;
--- /dev/null
+sub run_tests {
+
+plan tests => 3;
+
+# add some rows inside a transaction and commit it
+# XXX: Is storage->dbh the only way to get a dbh?
+DBICTest::Artist->storage->dbh->{AutoCommit} = 0;
+for (10..15) {
+ DBICTest::Artist->create( {
+ artistid => $_,
+ name => "artist number $_",
+ } );
+}
+DBICTest::Artist->dbi_commit;
+my ($artist) = DBICTest::Artist->find(15);
+is($artist->name, 'artist number 15', "Commit ok");
+
+# repeat the test using AutoCommit = 1 to force the commit
+DBICTest::Artist->storage->dbh->{AutoCommit} = 0;
+for (16..20) {
+ DBICTest::Artist->create( {
+ artistid => $_,
+ name => "artist number $_",
+ } );
+}
+DBICTest::Artist->storage->dbh->{AutoCommit} = 1;
+($artist) = DBICTest::Artist->find(20);
+is($artist->name, 'artist number 20', "Commit using AutoCommit ok");
+
+# add some rows inside a transaction and roll it back
+DBICTest::Artist->storage->dbh->{AutoCommit} = 0;
+for (21..30) {
+ DBICTest::Artist->create( {
+ artistid => $_,
+ name => "artist number $_",
+ } );
+}
+DBICTest::Artist->dbi_rollback;
+($artist) = DBICTest::Artist->search( artistid => 25 );
+is($artist, undef, "Rollback ok");
+
+}
+
+1;
--- /dev/null
+sub run_tests {
+
+plan tests => 2;
+
+ok(DBICTest::FourKeys->find(1,2,3,4), "find multiple pks without hash");
+ok(DBICTest::FourKeys->find(5,4,3,6), "find multiple pks without hash");
+
+}
+
+1;
--- /dev/null
+sub run_tests {
+
+plan tests => 13;
+
+# has_a test
+my $cd = DBICTest::CD->find(4);
+my ($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 = DBICTest::Artist->find(1);
+is( ($artist->search_related('cds'))[1]->title, 'Spoonful of bees', 'has_many search_related with order_by ok' );
+
+# search_related with additional abstract query
+my @cds = $artist->search_related('cds', { title => { like => '%of%' } } );
+is( $cds[1]->title, 'Forkful of bees', 'search_related with abstract query ok' );
+
+# creating a related object
+$artist->create_related( 'cds', {
+ title => 'Big Flop',
+ year => 2005,
+} );
+is( ($artist->search_related('cds'))[3]->title, 'Big Flop', 'create_related ok' );
+
+# count_related
+is( $artist->count_related('cds'), 4, 'count_related ok' );
+
+# set_from_related
+my $track = DBICTest::Track->create( {
+ trackid => 1,
+ cd => 3,
+ position => 98,
+ title => 'Hidden Track'
+} );
+$track->set_from_related( cd => $cd );
+
+if ($INC{'DBICTest/HelperRels.pm'}) { # except inflated object
+ is($track->cd->cdid, 4, 'set_from_related ok' );
+} else {
+ is( $track->cd, 4, 'set_from_related ok' );
+}
+
+# update_from_related, the same as set_from_related, but it calls update afterwards
+$track = DBICTest::Track->create( {
+ trackid => 2,
+ cd => 3,
+ position => 99,
+ title => 'Hidden Track'
+} );
+$track->update_from_related( cd => $cd );
+
+my $t_cd = (DBICTest::Track->search( cd => 4, position => 99 ))[0]->cd;
+
+if ($INC{'DBICTest/HelperRels.pm'}) { # except inflated object
+ is( $t_cd->cdid, 4, 'update_from_related ok' );
+} else {
+ is( $t_cd, 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' );
+
+SKIP: {
+ #skip 'Need to add delete_related', 1;
+ # delete_related
+ $artist->delete_related( cds => { title => 'Greatest Hits' });
+ cmp_ok( DBICTest::CD->search( title => 'Greatest Hits' ), '==', 0, 'delete_related ok' );
+};
+
+# try to add a bogus relationship using the wrong cols
+eval {
+ $artist->add_relationship(
+ tracks => 'DBICTest::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 {
+ $artist->add_relationship( tracks => 'DBICTest::Track' );
+};
+like($@, qr/join condition/, 'failed when creating a rel without join condition, ok');
+
+}
+
+1;
--- /dev/null
+sub run_tests {
+
+plan tests => 12;
+
+# first page
+my $it = DBICTest::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 = DBICTest::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 = DBICTest::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 = DBICTest::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" );
+
+}
+
+1;
--- /dev/null
+sub run_tests {
+
+eval { require DateTime };
+plan skip_all => "Need DateTime for inflation tests" if $@;
+
+plan tests => 3;
+
+DBICTest::CD->inflate_column( 'year',
+ { inflate => sub { DateTime->new( year => shift ) },
+ deflate => sub { shift->year } }
+);
+
+# inflation test
+my $cd = DBICTest::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) = DBICTest::CD->search( year => $now->year );
+is( $cd->year->year, $now->year, 'deflate ok' );
+
+}
+
+1;
--- /dev/null
+sub run_tests {
+
+eval { require DateTime };
+plan skip_all => "Need DateTime for inflation tests" if $@;
+
+plan tests => 6;
+
+DBICTest::CD->load_components(qw/CDBICompat::HasA/);
+
+DBICTest::CD->has_a( 'year', 'DateTime',
+ inflate => sub { DateTime->new( year => shift ) },
+ deflate => sub { shift->year }
+);
+
+# inflation test
+my $cd = DBICTest::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) = DBICTest::CD->search( year => $now->year );
+is( $cd->year->year, $now->year, 'deflate ok' );
+
+# re-test using alternate deflate syntax
+DBICTest::CD->has_a( 'year', 'DateTime',
+ inflate => sub { DateTime->new( year => shift ) },
+ deflate => 'year'
+);
+
+# inflation test
+$cd = DBICTest::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) = DBICTest::CD->search( year => $now->year );
+is( $cd->year->year, $now->year, 'deflate ok' );
+
+}
+
+1;
--- /dev/null
+sub run_tests {
+
+BEGIN {
+ eval "use DBD::SQLite";
+ plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 3);
+}
+
+my $art = DBICTest::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;
+
+}
+
+1;
--- /dev/null
+sub run_tests {
+
+plan tests => 1;
+
+DBICTest::Artist->load_components(qw/PK::Auto::SQLite/);
+
+# add an artist without primary key to test Auto
+my $artist = DBICTest::Artist->create( { name => 'Auto' } );
+$artist->name( 'Auto Change' );
+ok($artist->update, 'update on object created without PK ok');
+
+}
+
+1;
--- /dev/null
+sub run_tests {
+
+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 => 4;
+
+DBICTest::Schema->compose_connection('MySQLTest' => $dsn, $user, $pass);
+
+my $dbh = MySQLTest::Artist->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));");
+
+#'dbi:mysql:host=localhost;database=dbic_test', 'dbic_test', '');
+
+MySQLTest::Artist->load_components('PK::Auto::MySQL');
+
+# 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" );
+
+# clean up our mess
+$dbh->do("DROP TABLE artist");
+
+}
+
+1;
--- /dev/null
+sub run_tests {
+
+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'
+ unless ($dsn && $user);
+
+plan tests => 1;
+
+DBICTest::Schema->compose_connection('PgTest' => $dsn, $user, $pass);
+
+my $dbh = PgTest::Artist->storage->dbh;
+
+eval {
+ $dbh->do("DROP TABLE artist;");
+};
+
+$dbh->do("CREATE TABLE artist (artistid serial PRIMARY KEY, name VARCHAR(255));");
+
+PgTest::Artist->load_components('PK::Auto::Pg');
+
+my $new = PgTest::Artist->create({ name => 'foo' });
+
+ok($new->artistid, "Auto-PK worked");
+
+}
+
+1;
--- /dev/null
+sub run_tests {
+
+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 a table called \'artist\''
+ unless ($dsn && $user && $pass);
+
+plan tests => 4;
+
+DBICTest::Schema->compose_connection('OraTest' => $dsn, $user, $pass);
+
+my $dbh = OraTest::Artist->storage->dbh;
+
+eval {
+ $dbh->do("DROP SEQUENCE artist_seq");
+ $dbh->do("DROP TABLE artist");
+};
+$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("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::Oracle');
+
+# test primary key handling
+my $new = OraTest::Artist->create({ name => 'foo' });
+ok($new->artistid, "Oracle Auto-PK worked");
+
+# 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");
+
+}
+
+1;
--- /dev/null
+sub run_tests {\r
+\r
+my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_${_}" } qw/DSN USER PASS/};\r
+\r
+#warn "$dsn $user $pass";\r
+\r
+plan skip_all, 'Set $ENV{DBICTEST_MSSQL_DSN}, _USER and _PASS to run this test'\r
+ unless ($dsn);\r
+\r
+plan tests => 4;\r
+\r
+DBICTest::Schema->compose_connection( 'MSSQLTest' => $dsn, $user, $pass );\r
+\r
+my $dbh = MSSQLTest::Artist->storage->dbh;\r
+\r
+$dbh->do("IF OBJECT_ID('artist', 'U') IS NOT NULL\r
+ DROP TABLE artist");\r
+\r
+$dbh->do("CREATE TABLE artist (artistid INT IDENTITY PRIMARY KEY, name VARCHAR(255));");\r
+\r
+MSSQLTest::Artist->load_components('PK::Auto::MSSQL');\r
+\r
+# Test PK\r
+my $new = MSSQLTest::Artist->create( { name => 'foo' } );\r
+ok($new->artistid, "Auto-PK worked");\r
+\r
+# Test LIMIT\r
+for (1..6) {\r
+ MSSQLTest::Artist->create( { name => 'Artist ' . $_ } );\r
+}\r
+\r
+my $it = MSSQLTest::Artist->search( { },\r
+ { rows => 3,\r
+ offset => 2,\r
+ order_by => 'artistid'\r
+ }\r
+);\r
+\r
+is( $it->count, 3, "LIMIT count ok" );\r
+is( $it->next->name, "Artist 2", "iterator->next ok" );\r
+$it->next;\r
+$it->next;\r
+is( $it->next, undef, "next past end of resultset ok" );\r
+\r
+}\r
+\r
+1;\r
--- /dev/null
+sub run_tests {
+
+BEGIN {
+ eval "use DBD::SQLite";
+ plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 9);
+}
+
+# test LIMIT
+my $it = DBICTest::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 = DBICTest::CD->search( {},
+ { rows => 2,
+ offset => 2,
+ order_by => 'year' }
+);
+is( $cds[0]->title, "Spoonful of bees", "offset ok" );
+
+# test software-based limiting
+$it = DBICTest::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 = DBICTest::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 = DBICTest::CD->search(
+ { title => [
+ -and =>
+ {
+ -like => '%bees'
+ },
+ {
+ -not_like => 'Forkful%'
+ }
+ ]
+ },
+ { rows => 5 }
+);
+is( $it->count, 1, "complex abstract count ok" );
+
+}
+
+1;
--- /dev/null
+sub run_tests {
+
+use IO::File;
+
+BEGIN {
+ eval "use DBD::SQLite";
+ plan $@
+ ? ( skip_all => 'needs DBD::SQLite for testing' )
+ : ( tests => 21 );
+}
+
+# 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 = DBICTest::CD->search(
+ { 'year' => 2001, 'artist.name' => 'Caterwauler McCrae' },
+ { from => [ { 'me' => 'cd' },
+ [
+ { artist => 'artist' },
+ { 'me.artist' => 'artist.artistid' }
+ ] ] }
+ );
+
+cmp_ok( $rs->count, '==', 1, "Single record in resultset");
+
+is($rs->first->title, 'Forkful of bees', 'Correct record returned');
+
+$rs = DBICTest::CD->search(
+ { 'year' => 2001, 'artist.name' => 'Caterwauler McCrae' },
+ { join => 'artist' });
+
+cmp_ok( $rs->count, '==', 1, "Single record in resultset");
+
+is($rs->first->title, 'Forkful of bees', 'Correct record returned');
+
+$rs = DBICTest::CD->search(
+ { 'artist.name' => 'We Are Goth',
+ 'liner_notes.notes' => 'Kill Yourself!' },
+ { join => [ qw/artist liner_notes/ ] });
+
+cmp_ok( $rs->count, '==', 1, "Single record in resultset");
+
+is($rs->first->title, 'Come Be Depressed With Us', 'Correct record returned');
+
+$rs = DBICTest::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');
+
+DBICTest::Schema::CD->add_relationship(
+ artist => 'DBICTest::Schema::Artist',
+ { 'foreign.artistid' => 'self.artist' },
+ { accessor => 'filter' },
+);
+
+DBICTest::Schema::CD->add_relationship(
+ liner_notes => 'DBICTest::Schema::LinerNotes',
+ { 'foreign.liner_id' => 'self.cdid' },
+ { join_type => 'LEFT', accessor => 'single' });
+
+$rs = DBICTest::CD->search(
+ { 'artist.name' => 'Caterwauler McCrae' },
+ { prefetch => [ qw/artist liner_notes/ ],
+ order_by => 'me.cdid' });
+
+cmp_ok($rs->count, '==', 3, 'Correct number of records returned');
+
+# start test for prefetch SELECT count
+unlink 't/var/dbic.trace' if -e 't/var/dbic.trace';
+DBI->trace(1, 't/var/dbic.trace');
+
+my @cd = $rs->all;
+
+is($cd[0]->title, 'Spoonful of bees', 'First record returned ok');
+
+ok(!exists $cd[0]->{_relationship_data}{liner_notes}, 'No prefetch for NULL LEFT JOIN');
+
+is($cd[1]->{_relationship_data}{liner_notes}->notes, 'Buy Whiskey!', 'Prefetch for present LEFT JOIN');
+
+is($cd[2]->{_inflated_column}{artist}->name, 'Caterwauler McCrae', 'Prefetch on parent object ok');
+
+# count the SELECTs
+DBI->trace(0);
+my $selects = 0;
+my $trace = IO::File->new('t/var/dbic.trace', '<')
+ or die "Unable to read trace file";
+while (<$trace>) {
+ $selects++ if /SELECT/;
+}
+$trace->close;
+unlink 't/var/dbic.trace';
+is($selects, 1, 'prefetch ran only 1 select statement');
+
+my ($artist) = DBICTest::Artist->search({ 'cds.year' => 2001 },
+ { order_by => 'artistid DESC', join => 'cds' });
+
+is($artist->name, 'Random Boy Band', "Join search by object ok");
+
+my @cds = DBICTest::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 = DBICTest::Artist->search({ 'tags.tag' => 'Shiny' },
+ { join => { 'cds' => 'tags' } });
+
+cmp_ok( @artists, '==', 2, "two-join search ok" );
+
+}
+
+1;
--- /dev/null
+sub run_tests {
+
+eval "use DBD::SQLite";
+plan skip_all => 'needs DBD::SQLite for testing' if $@;
+plan tests => 4;
+
+cmp_ok(DBICTest::CD->count({ 'artist.name' => 'Caterwauler McCrae' },
+ { join => 'artist' }),
+ '==', 3, 'Count by has_a ok');
+
+cmp_ok(DBICTest::CD->count({ 'tags.tag' => 'Blue' }, { join => 'tags' }),
+ '==', 4, 'Count by has_many ok');
+
+cmp_ok(DBICTest::CD->count(
+ { 'liner_notes.notes' => { '!=' => undef } },
+ { join => 'liner_notes' }),
+ '==', 3, 'Count by might_have ok');
+
+cmp_ok(DBICTest::CD->count(
+ { 'year' => { '>', 1998 }, 'tags.tag' => 'Cheesy',
+ 'liner_notes.notes' => { 'like' => 'Buy%' } },
+ { join => [ qw/tags liner_notes/ ] } ),
+ '==', 2, "Mixed count ok");
+
+}
+
+1;
--- /dev/null
+sub run_tests {\r
+\r
+# this test will check to see if you can have 2 columns\r
+# in the same class pointing at the same other class\r
+#\r
+# example:\r
+#\r
+# +---------+ +--------------+\r
+# | SelfRef | | SelfRefAlias |\r
+# +---------+ 1-M +--------------+\r
+# | id |-------| self_ref | --+\r
+# | name | | alias | --+\r
+# +---------+ +--------------+ |\r
+# /|\ |\r
+# | |\r
+# +--------------------------------+\r
+#\r
+# see http://use.perl.org/~LTjake/journal/24876 for the\r
+# issue with CDBI\r
+\r
+plan tests => 4;\r
+\r
+my $item = DBICTest::SelfRef->find( 1 );\r
+is( $item->name, 'First', 'proper start item' );\r
+\r
+my @aliases = $item->aliases;\r
+\r
+is( scalar @aliases, 1, 'proper number of aliases' );\r
+\r
+my $orig = $aliases[ 0 ]->self_ref;\r
+my $alias = $aliases[ 0 ]->alias;\r
+\r
+is( $orig->name, 'First', 'proper original' );\r
+is( $alias->name, 'Second', 'proper alias' );\r
+\r
+}\r
+\r
+1;\r
projects / dbsrgits/DBIx-Class.git / commitdiff