use warnings;
use base qw/DBIx::Class::CDBICompat::Convenience
+ DBIx::Class::CDBICompat::Triggers
+ DBIx::Class::CDBICompat::GetSet
+ DBIx::Class::CDBICompat::AttributeAPI
DBIx::Class::CDBICompat::Stringify
DBIx::Class::CDBICompat::ObjIndexStubs
DBIx::Class::CDBICompat::DestroyWarning
DBIx::Class::CDBICompat::Constructor
- DBIx::Class::CDBICompat::AutoUpdate
DBIx::Class::CDBICompat::AccessorMapping
DBIx::Class::CDBICompat::ColumnCase
+ DBIx::Class::CDBICompat::LazyLoading
+ DBIx::Class::CDBICompat::AutoUpdate
DBIx::Class::CDBICompat::ColumnGroups
DBIx::Class::CDBICompat::ImaDBI/;
sub _mk_column_accessors {
my ($class, @cols) = @_;
unless ($class->can('accessor_name') || $class->can('mutator_name')) {
- return $class->NEXT::_mk_column_accessors(@cols);
+ return $class->NEXT::_mk_column_accessors('column' => @cols);
}
foreach my $col (@cols) {
my $ro_meth = ($class->can('accessor_name')
? $class->mutator_name($col)
: $col);
if ($ro_meth eq $wo_meth) {
- $class->mk_accessors($col);
+ $class->mk_group_accessors('column' => $col);
} else {
- $class->mk_ro_accessors($ro_meth);
- $class->mk_wo_accessors($wo_meth);
+ $class->mk_group_ro_accessors('column' => $ro_meth);
+ $class->mk_group_wo_accessors('column' => $wo_meth);
}
}
}
__PACKAGE__->mk_classdata('__AutoCommit');
-sub set {
+sub set_column {
my $self = shift;
- $self->NEXT::set(@_);
+ my $ret = $self->NEXT::set_column(@_);
$self->update if ($self->autoupdate && $self->{_in_database});
+ return $ret;
}
sub autoupdate {
return $class->NEXT::_register_columns(map lc, @cols);
}
-sub get {
+sub get_column {
my ($class, $get, @rest) = @_;
- return $class->NEXT::get(lc $get, @rest);
+ return $class->NEXT::get_column(lc $get, @rest);
}
-sub set {
+sub set_column {
my ($class, $set, @rest) = @_;
- return $class->NEXT::set(lc $set, @rest);
+ return $class->NEXT::set_column(lc $set, @rest);
+}
+
+sub store_column {
+ my ($class, $set, @rest) = @_;
+ return $class->NEXT::store_column(lc $set, @rest);
}
sub find_column {
return $class->NEXT::find_column(lc $col);
}
-sub _mk_accessors {
- my ($class, $type, @fields) = @_;
+sub _mk_group_accessors {
+ my ($class, $type, $group, @fields) = @_;
my %fields;
$fields{$_} = 1 for @fields,
map lc, grep { !defined &{"${class}::${_}"} } @fields;
- return $class->NEXT::_mk_accessors($type, keys %fields);
+ return $class->NEXT::_mk_group_accessors($type, $group, keys %fields);
}
1;
__PACKAGE__->mk_classdata('_column_groups' => { });
-sub table {
- shift->_table_name(@_);
-}
-
sub columns {
my $proto = shift;
my $class = ref $proto || $proto;
my $group = shift || "All";
- $class->_set_column_group($group => @_) if @_;
+ $class->_add_column_group($group => @_) if @_;
return $class->all_columns if $group eq "All";
return $class->primary_column if $group eq "Primary";
return keys %{$class->_column_groups->{$group}};
}
-sub _set_column_group {
+sub _add_column_group {
my ($class, $group, @cols) = @_;
$class->_register_column_group($group => @cols);
- #$class->_register_columns(@cols);
- #$class->_mk_column_accessors(@cols);
- $class->set_columns(@cols);
+ $class->add_columns(@cols);
}
sub _register_column_group {
my ($class, $group, @cols) = @_;
if ($group eq 'Primary') {
- $class->set_primary(@cols);
+ $class->set_primary_key(@cols);
}
my $groups = { %{$class->_column_groups} };
if ($group eq 'All') {
- unless ($class->_column_groups->{'Primary'}) {
+ unless (exists $class->_column_groups->{'Primary'}) {
$groups->{'Primary'}{$cols[0]} = {};
- $class->_primaries({ $cols[0] => {} });
+ $class->set_primary_key($cols[0]);
}
- unless ($class->_column_groups->{'Essential'}) {
+ unless (exists $class->_column_groups->{'Essential'}) {
$groups->{'Essential'}{$cols[0]} = {};
}
}
$groups->{$group}{$_} ||= {} for @cols;
+ if ($group eq 'Essential') {
+ $groups->{$group}{$_} ||= {} for keys %{ $class->_primaries || {} };
+ }
$class->_column_groups($groups);
}
sub {
my $sql = $sql;
my $class = shift;
- my $table = $class->_table_name;
- $sql =~ s/__TABLE__/$table/;
- return $class->_sql_to_sth(sprintf($sql, @_));
+ return $class->_sql_to_sth($class->transform_sql($sql, @_));
};
+ if ($sql =~ /select/i) {
+ my $meth = "sql_${name}";
+ *{"${class}::search_${name}"} =
+ sub {
+ my ($class, @args) = @_;
+ $class->sth_to_objects($class->$meth, \@args);
+ };
+ }
+}
+
+sub transform_sql {
+ my ($class, $sql, @args) = @_;
+ my $table = $class->_table_name;
+ $sql =~ s/__TABLE__/$table/g;
+ $sql =~ s/__ESSENTIAL__/join(' ', $class->columns('Essential'))/eg;
+ return sprintf($sql, @args);
}
1;
my $self = shift;
my @cols = $self->columns('Stringify');
@cols = $self->primary_column unless @cols;
- my $ret = join "/", map { $self->get($_) } @cols;
+ my $ret = join "/", map { $self->get_column($_) } @cols;
return $ret || ref $self;
}
use base qw/DBIx::Class::PK
DBIx::Class::Table
DBIx::Class::SQL
- DBIx::Class::DB/;
+ DBIx::Class::DB
+ DBIx::Class::AccessorGroup/;
1;
return (map { $self->{_column_data}{$_} } keys %{$self->_primaries});
}
-sub set_primary {
+sub set_primary_key {
my ($class, @cols) = @_;
my %pri;
$pri{$_} = {} for @cols;
return ($class->search($query))[0];
}
+sub discard_changes {
+ my ($self) = @_;
+ delete $self->{_dirty_columns};
+ $_[0] = $self->retrieve($self->id);
+}
+
1;
use strict;
use warnings;
-use base qw/Class::Data::Inheritable Class::Accessor DBIx::Class::SQL/;
+use base qw/Class::Data::Inheritable DBIx::Class::SQL/;
__PACKAGE__->mk_classdata('_columns' => {});
if ($attrs) {
die "attrs must be a hashref" unless ref($attrs) eq 'HASH';
while (my ($k, $v) = each %{$attrs}) {
- $new->set($k => $v);
+ $new->store_column($k => $v);
}
}
- $new->{_dirty_columns} = {};
return $new;
}
return $self;
}
-sub discard_changes {
- my ($self) = @_;
- $_[0] = $self->retrieve($self->id);
-}
-
-sub get {
+sub get_column {
my ($self, $column) = @_;
die "Can't fetch data as class method" unless ref $self;
- #die "No such column '${column}'" unless $self->_columns->{$column};
+ die "No such column '${column}'" unless $self->_columns->{$column};
return $self->{_column_data}{$column} if $self->_columns->{$column};
- return shift->SUPER::get(@_);
}
-sub set {
+sub set_column {
+ my $self = shift;
+ my ($column) = @_;
+ my $ret = $self->store_column(@_);
+ $self->{_dirty_columns}{$column} = 1;
+ return $ret;
+}
+
+sub store_column {
my ($self, $column, $value) = @_;
- #die "No such column '${column}'" unless $self->_columns->{$column};
- #die "set_column called for ${column} without value" if @_ < 3;
- if ($self->_columns->{$column}) {
- $self->{_dirty_columns}{$column} = 1;
- return $self->{_column_data}{$column} = $value;
- }
- return shift->SUPER::set(@_);
+ die "No such column '${column}'" unless $self->_columns->{$column};
+ die "set_column called for ${column} without value" if @_ < 3;
+ return $self->{_column_data}{$column} = $value;
}
sub _register_columns {
sub _mk_column_accessors {
my ($class, @cols) = @_;
- $class->mk_accessors(@cols);
+ $class->mk_group_accessors('column' => @cols);
}
-sub set_columns {
+sub add_columns {
my ($class, @cols) = @_;
$class->_register_columns(@cols);
$class->_mk_column_accessors(@cols);
$cond =~ s/^\s*WHERE//i;
my @cols = $class->_select_columns;
my $sth = $class->_get_sth( 'select', \@cols, $class->_table_name, $cond);
- $sth->execute(@vals);
+ return $class->sth_to_objects($sth, \@vals, \@cols);
+}
+
+sub sth_to_objects {
+ my ($class, $sth, $args, $cols) = @_;
+ my @cols = ((ref $cols eq 'ARRAY') ? @$cols : @{$sth->{NAME_lc}} );
+ $sth->execute(@$args);
my @found;
while (my @row = $sth->fetchrow_array) {
my $new = $class->new;
- $new->set($_, shift @row) for @cols;
+ $new->store_column($_, shift @row) for @cols;
$new->{_in_database} = 1;
- $new->{_dirty_columns} = {};
push(@found, $new);
}
return @found;
sub copy {
my ($self, $changes) = @_;
my $new = bless({ _column_data => { %{$self->{_column_data}}} }, ref $self);
- $new->set($_ => $changes->{$_}) for keys %$changes;
+ $new->set_column($_ => $changes->{$_}) for keys %$changes;
return $new->insert;
}
return ($cond, [ values %$query ]);
}
+sub table {
+ shift->_table_name(@_);
+}
+
1;
my @grps = sort State->__grouper->groups_for(State->_find_columns(qw/rain capital/));
is @grps, 2, "Rain and Capital = 2 groups";
- my @grps = sort @grps; # Because DBIx::Class is hash-based
+ @grps = sort @grps; # Because DBIx::Class is hash-based
is $grps[0], 'Other', " - Other";
is $grps[1], 'Weather', " - Weather";
}
$btaste3->NumExplodingSheep(13);
}
is @warnings, 1, "DESTROY without update warns";
+print join("\n", @warnings);
Film->autoupdate(0);
}
--- /dev/null
+use strict;
+use Test::More;
+
+#----------------------------------------------------------------------
+# Make sure subclasses can be themselves subclassed
+#----------------------------------------------------------------------
+
+BEGIN {
+ eval "use DBD::SQLite";
+ plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 6);
+}
+
+use lib 't/testlib';
+use Film;
+
+INIT { @Film::Threat::ISA = qw/Film/; }
+
+ok(Film::Threat->db_Main->ping, 'subclass db_Main()');
+is_deeply [ sort Film::Threat->columns ], [ sort Film->columns ],
+ 'has the same columns';
+
+my $bt = Film->create_test_film;
+ok my $btaste = Film::Threat->retrieve('Bad Taste'), "subclass retrieve";
+isa_ok $btaste => "Film::Threat";
+isa_ok $btaste => "Film";
+is $btaste->Title, 'Bad Taste', 'subclass get()';
--- /dev/null
+use strict;
+use Test::More;
+
+#----------------------------------------------------------------------
+# Test lazy loading
+#----------------------------------------------------------------------
+
+BEGIN {
+ eval "use DBD::SQLite";
+ plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 25);
+}
+
+INIT {
+ use lib 't/testlib';
+ use Lazy;
+}
+
+is_deeply [ Lazy->columns('Primary') ], [qw/this/], "Pri";
+is_deeply [ sort Lazy->columns('Essential') ], [qw/opop this/], "Essential";
+is_deeply [ sort Lazy->columns('things') ], [qw/that this/], "things";
+is_deeply [ sort Lazy->columns('horizon') ], [qw/eep orp/], "horizon";
+is_deeply [ sort Lazy->columns('vertical') ], [qw/oop opop/], "vertical";
+is_deeply [ sort Lazy->columns('All') ], [qw/eep oop opop orp that this/], "All";
+
+{
+ my @groups = Lazy->__grouper->groups_for(Lazy->find_column('this'));
+ is_deeply [ sort @groups ], [sort qw/things Essential Primary/], "this (@groups)";
+}
+
+{
+ my @groups = Lazy->__grouper->groups_for(Lazy->find_column('that'));
+ is_deeply \@groups, [qw/things/], "that (@groups)";
+}
+
+Lazy->create({ this => 1, that => 2, oop => 3, opop => 4, eep => 5 });
+
+ok(my $obj = Lazy->retrieve(1), 'Retrieve by Primary');
+ok($obj->_attribute_exists('this'), "Gets primary");
+ok($obj->_attribute_exists('opop'), "Gets other essential");
+ok(!$obj->_attribute_exists('that'), "But other things");
+ok(!$obj->_attribute_exists('eep'), " nor eep");
+ok(!$obj->_attribute_exists('orp'), " nor orp");
+ok(!$obj->_attribute_exists('oop'), " nor oop");
+
+ok(my $val = $obj->eep, 'Fetch eep');
+ok($obj->_attribute_exists('orp'), 'Gets orp too');
+ok(!$obj->_attribute_exists('oop'), 'But still not oop');
+ok(!$obj->_attribute_exists('that'), 'nor that');
+
+{
+ Lazy->columns(All => qw/this that eep orp oop opop/);
+ ok(my $obj = Lazy->retrieve(1), 'Retrieve by Primary');
+ ok !$obj->_attribute_exists('oop'), " Don't have oop";
+ my $null = $obj->eep;
+ ok !$obj->_attribute_exists('oop'),
+ " Don't have oop - even after getting eep";
+}
+
+# Test contructor breaking.
+
+eval { # Need a hashref
+ Lazy->create(this => 10, that => 20, oop => 30, opop => 40, eep => 50);
+};
+ok($@, $@);
+
+eval { # False column
+ Lazy->create({ this => 10, that => 20, theother => 30 });
+};
+ok($@, $@);
+
+eval { # Multiple false columns
+ Lazy->create({ this => 10, that => 20, theother => 30, andanother => 40 });
+};
+ok($@, $@);
+
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More tests => 3;
+
+use DBIx::Class;
+
+package A;
+@A::ISA = qw(DBIx::Class);
+__PACKAGE__->columns(Primary => 'id');
+
+package A::B;
+@A::B::ISA = 'A';
+__PACKAGE__->columns(All => qw(id b1));
+
+package A::C;
+@A::C::ISA = 'A';
+__PACKAGE__->columns(All => qw(id c1 c2 c3));
+
+package main;
+is join (' ', sort A->columns), 'id', "A columns";
+is join (' ', sort A::B->columns), 'b1 id', "A::B columns";
+is join (' ', sort A::C->columns), 'c1 c2 c3 id', "A::C columns";
--- /dev/null
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBD::SQLite";
+ plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 13);
+}
+
+use lib 't/testlib';
+use Film;
+
+sub create_trigger2 { ::ok(1, "Running create trigger 2"); }
+sub delete_trigger { ::ok(1, "Deleting " . shift->Title) }
+
+sub pre_up_trigger {
+ $_[0]->_attribute_set(numexplodingsheep => 1);
+ ::ok(1, "Running pre-update trigger");
+}
+sub pst_up_trigger { ::ok(1, "Running post-update trigger"); }
+
+sub default_rating { $_[0]->Rating(15); }
+
+Film->add_trigger(
+ before_create => \&default_rating,
+ after_create => \&create_trigger2,
+ after_delete => \&delete_trigger,
+ before_update => \&pre_up_trigger,
+ after_update => \&pst_up_trigger,
+);
+
+ok(
+ my $ver = Film->create({
+ title => 'La Double Vie De Veronique',
+ director => 'Kryzstof Kieslowski',
+
+ # rating => '15',
+ numexplodingsheep => 0,
+ }
+ ),
+ "Create Veronique"
+);
+
+is $ver->Rating, 15, "Default rating";
+is $ver->NumExplodingSheep, 0, "Original sheep count";
+ok $ver->Rating('12') && $ver->update, "Change the rating";
+is $ver->NumExplodingSheep, 1, "Updated object's sheep count";
+is + (
+ $ver->db_Main->selectall_arrayref(
+ 'SELECT numexplodingsheep FROM '
+ . $ver->table
+ . ' WHERE '
+ . $ver->primary_column . ' = '
+ . $ver->db_Main->quote($ver->id))
+)->[0]->[0], 1, "Updated database's sheep count";
+ok $ver->delete, "Delete";
+
+{
+ Film->add_trigger(before_create => sub {
+ my $self = shift;
+ ok !$self->_attribute_exists('title'), "PK doesn't auto-vivify";
+ });
+ Film->create({director => "Me"});
+}
--- /dev/null
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBD::SQLite";
+ plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 17);
+}
+
+use lib 't/testlib';
+use Film;
+use Actor;
+
+{ # Check __ESSENTIAL__ expansion (RT#13038)
+ my @cols = Film->columns('Essential');
+ is_deeply \@cols, ['title'], "1 Column in essential";
+ is +Film->transform_sql('__ESSENTIAL__'), 'title', '__ESSENTIAL__ expansion';
+}
+
+my $f1 = Film->create({ title => 'A', director => 'AA', rating => 'PG' });
+my $f2 = Film->create({ title => 'B', director => 'BA', rating => 'PG' });
+my $f3 = Film->create({ title => 'C', director => 'AA', rating => '15' });
+my $f4 = Film->create({ title => 'D', director => 'BA', rating => '18' });
+my $f5 = Film->create({ title => 'E', director => 'AA', rating => '18' });
+
+Film->set_sql(
+ pgs => qq{
+ SELECT __ESSENTIAL__
+ FROM __TABLE__
+ WHERE __TABLE__.rating = 'PG'
+ ORDER BY title DESC
+}
+);
+
+{
+ (my $sth = Film->sql_pgs())->execute;
+ my @pgs = Film->sth_to_objects($sth);
+ is @pgs, 2, "Execute our own SQL";
+ is $pgs[0]->id, $f2->id, "get F2";
+ is $pgs[1]->id, $f1->id, "and F1";
+}
+
+{
+ my @pgs = Film->search_pgs;
+ is @pgs, 2, "SQL creates search() method";
+ is $pgs[0]->id, $f2->id, "get F2";
+ is $pgs[1]->id, $f1->id, "and F1";
+};
+
+Film->set_sql(
+ rating => qq{
+ SELECT __ESSENTIAL__
+ FROM __TABLE__
+ WHERE rating = ?
+ ORDER BY title DESC
+}
+);
+
+{
+ my @pgs = Film->search_rating('18');
+ is @pgs, 2, "Can pass parameters to created search()";
+ is $pgs[0]->id, $f5->id, "F5";
+ is $pgs[1]->id, $f4->id, "and F4";
+};
+
+{
+ Actor->has_a(film => "Film");
+ Film->set_sql(
+ namerate => qq{
+ SELECT __ESSENTIAL(f)__
+ FROM __TABLE(=f)__, __TABLE(Actor=a)__
+ WHERE __JOIN(a f)__
+ AND a.name LIKE ?
+ AND f.rating = ?
+ ORDER BY title
+ }
+ );
+
+ my $a1 = Actor->create({ name => "A1", film => $f1 });
+ my $a2 = Actor->create({ name => "A2", film => $f2 });
+ my $a3 = Actor->create({ name => "B1", film => $f1 });
+
+ my @apg = Film->search_namerate("A_", "PG");
+ is @apg, 2, "2 Films with A* that are PG";
+ is $apg[0]->title, "A", "A";
+ is $apg[1]->title, "B", "and B";
+}
+
+{ # join in reverse
+ Actor->has_a(film => "Film");
+ Film->set_sql(
+ ratename => qq{
+ SELECT __ESSENTIAL(f)__
+ FROM __TABLE(=f)__, __TABLE(Actor=a)__
+ WHERE __JOIN(f a)__
+ AND f.rating = ?
+ AND a.name LIKE ?
+ ORDER BY title
+ }
+ );
+
+ my @apg = Film->search_ratename(PG => "A_");
+ is @apg, 2, "2 Films with A* that are PG";
+ is $apg[0]->title, "A", "A";
+ is $apg[1]->title, "B", "and B";
+}
+
--- /dev/null
+package DBICTest;
+
+use strict;
+use warnings;
+use base qw/DBIx::Class::Core/;
+
+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";
+
+__PACKAGE__->connection("dbi:SQLite:${db_file}");
+
+my $dbh = __PACKAGE__->_get_dbh;
+
+my $sql = <<EOSQL;
+CREATE TABLE artist (artistid INTEGER NOT NULL PRIMARY KEY, name VARCHAR);
+
+CREATE TABLE cd (cdid INTEGER NOT NULL PRIMARY KEY, artist INTEGER NOT NULL,
+ title VARCHAR, year VARCHAR);
+
+CREATE TABLE liner_notes (liner_id INTEGER NOT NULL PRIMARY KEY, notes VARCHAR);
+
+CREATE TABLE track (trackid INTEGER NOT NULL PRIMARY KEY, cd INTEGER NOT NULL,
+ position INTEGER NOT NULL, title VARCHAR);
+
+CREATE TABLE tags (tagid INTEGER NOT NULL PRIMARY KEY, cd INTEGER NOT NULL,
+ tag VARCHAR);
+
+CREATE TABLE twokeys (artist INTEGER NOT NULL, cd INTEGER NOT NULL,
+ PRIMARY KEY (artist, cd) );
+
+CREATE TABLE onekey (id INTEGER NOT NULL PRIMARY KEY,
+ artist INTEGER NOT NULL, cd INTEGER NOT NULL );
+
+INSERT INTO artist (artistid, name) VALUES (1, 'Caterwauler McCrae');
+
+INSERT INTO artist (artistid, name) VALUES (2, 'Random Boy Band');
+
+INSERT INTO artist (artistid, name) VALUES (3, 'We Are Goth');
+
+INSERT INTO cd (cdid, artist, title, year)
+ VALUES (1, 1, "Spoonful of bees", 1999);
+
+INSERT INTO cd (cdid, artist, title, year)
+ VALUES (2, 1, "Forkful of bees", 2001);
+
+INSERT INTO cd (cdid, artist, title, year)
+ VALUES (3, 1, "Caterwaulin' Blues", 1997);
+
+INSERT INTO cd (cdid, artist, title, year)
+ VALUES (4, 2, "Generic Manufactured Singles", 2001);
+
+INSERT INTO cd (cdid, artist, title, year)
+ VALUES (5, 3, "Come Be Depressed With Us", 1998);
+
+INSERT INTO liner_notes (liner_id, notes)
+ VALUES (2, "Buy Whiskey!");
+
+INSERT INTO liner_notes (liner_id, notes)
+ VALUES (4, "Buy Merch!");
+
+INSERT INTO liner_notes (liner_id, notes)
+ VALUES (5, "Kill Yourself!");
+
+INSERT INTO tags (tagid, cd, tag) VALUES (1, 1, "Blue");
+
+INSERT INTO tags (tagid, cd, tag) VALUES (2, 2, "Blue");
+
+INSERT INTO tags (tagid, cd, tag) VALUES (3, 3, "Blue");
+
+INSERT INTO tags (tagid, cd, tag) VALUES (4, 5, "Blue");
+
+INSERT INTO tags (tagid, cd, tag) VALUES (5, 2, "Cheesy");
+
+INSERT INTO tags (tagid, cd, tag) VALUES (6, 4, "Cheesy");
+
+INSERT INTO tags (tagid, cd, tag) VALUES (7, 5, "Cheesy");
+
+INSERT INTO tags (tagid, cd, tag) VALUES (8, 2, "Shiny");
+
+INSERT INTO tags (tagid, cd, tag) VALUES (9, 4, "Shiny");
+
+INSERT INTO twokeys (artist, cd) VALUES (1, 1);
+
+INSERT INTO twokeys (artist, cd) VALUES (1, 2);
+
+INSERT INTO twokeys (artist, cd) VALUES (2, 2);
+
+INSERT INTO onekey (id, artist, cd) VALUES (1, 1, 1);
+
+INSERT INTO onekey (id, artist, cd) VALUES (2, 1, 2);
+
+INSERT INTO onekey (id, artist, cd) VALUES (3, 2, 2);
+EOSQL
+
+$dbh->do($_) for split(/\n\n/, $sql);
+
+package DBICTest::LinerNotes;
+
+use base 'DBICTest';
+
+DBICTest::LinerNotes->table('liner_notes');
+DBICTest::LinerNotes->add_columns(qw/liner_id notes/);
+DBICTest::LinerNotes->set_primary_key('liner_id');
+
+package DBICTest::Tag;
+
+use base 'DBICTest';
+
+DBICTest::Tag->table('tags');
+DBICTest::Tag->add_columns(qw/tagid cd tag/);
+DBICTest::Tag->set_primary_key('tagid');
+#DBICTest::Tag->has_a(cd => 'SweetTest::CD');
+
+package DBICTest::Track;
+
+use base 'DBICTest';
+
+DBICTest::Track->table('track');
+DBICTest::Track->add_columns(qw/trackid cd position title/);
+DBICTest::Track->set_primary_key('trackid');
+#DBICTest::Track->has_a(cd => 'SweetTest::CD');
+
+package DBICTest::CD;
+
+use base 'DBICTest';
+
+DBICTest::CD->table('cd');
+DBICTest::CD->add_columns(qw/cdid artist title year/);
+DBICTest::CD->set_primary_key('trackid');
+
+#DBICTest::CD->has_many(tracks => 'SweetTest::Track');
+#DBICTest::CD->has_many(tags => 'SweetTest::Tag');
+#DBICTest::CD->has_a(artist => 'SweetTest::Artist');
+
+#DBICTest::CD->might_have(liner_notes => 'SweetTest::LinerNotes' => qw/notes/);
+
+package DBICTest::Artist;
+
+use base 'DBICTest';
+
+DBICTest::Artist->table('artist');
+DBICTest::Artist->add_columns(qw/artistid name/);
+DBICTest::Artist->set_primary_key('artistid');
+#DBICTest::Artist->has_many(cds => 'SweetTest::CD');
+#DBICTest::Artist->has_many(twokeys => 'SweetTest::TwoKeys');
+#DBICTest::Artist->has_many(onekeys => 'SweetTest::OneKey');
+
+package DBICTest::TwoKeys;
+
+use base 'DBICTest';
+
+DBICTest::TwoKeys->table('twokeys');
+DBICTest::TwoKeys->add_columns(qw/artist cd/);
+DBICTest::TwoKeys->set_primary_key(qw/artist cd/);
+#DBICTest::TwoKeys->has_a(artist => 'SweetTest::Artist');
+#DBICTest::TwoKeys->has_a(cd => 'SweetTest::CD');
+
+package DBICTest::OneKey;
+
+use base 'DBICTest';
+
+DBICTest::OneKey->table('onekey');
+DBICTest::OneKey->add_columns(qw/id artist cd/);
+DBICTest::TwoKeys->set_primary_key('id');
+
+1;