First of a two-parter :)
Matt S Trout [Thu, 21 Jul 2005 12:31:03 +0000 (12:31 +0000)]
18 files changed:
lib/DBIx/Class/CDBICompat.pm
lib/DBIx/Class/CDBICompat/AccessorMapping.pm
lib/DBIx/Class/CDBICompat/AutoUpdate.pm
lib/DBIx/Class/CDBICompat/ColumnCase.pm
lib/DBIx/Class/CDBICompat/ColumnGroups.pm
lib/DBIx/Class/CDBICompat/ImaDBI.pm
lib/DBIx/Class/CDBICompat/Stringify.pm
lib/DBIx/Class/Core.pm
lib/DBIx/Class/PK.pm
lib/DBIx/Class/Table.pm
t/01-columns.t
t/02-Film.t
t/cdbi-t/03-subclassing.t [new file with mode: 0644]
t/cdbi-t/04-lazy.t [new file with mode: 0644]
t/cdbi-t/08-inheritcols.t [new file with mode: 0644]
t/cdbi-t/11-triggers.t [new file with mode: 0644]
t/cdbi-t/19-set_sql.t [new file with mode: 0644]
t/lib/DBICTest.pm [new file with mode: 0755]

index 2380191..fc30d0a 100644 (file)
@@ -4,13 +4,17 @@ use strict;
 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/;
 
index cdfd851..e5703c9 100644 (file)
@@ -8,7 +8,7 @@ use NEXT;
 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')
@@ -18,10 +18,10 @@ sub _mk_column_accessors {
                     ? $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);
     }
   }
 }
index e61e167..f576276 100644 (file)
@@ -7,10 +7,11 @@ use base qw/Class::Data::Inheritable/;
 
 __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 {
index fe9084a..e5c23d8 100644 (file)
@@ -14,14 +14,19 @@ sub _register_columns {
   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 {
@@ -29,12 +34,12 @@ 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;
index 1c32842..ed5a967 100644 (file)
@@ -8,47 +8,44 @@ use base qw/Class::Data::Inheritable/;
 
 __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);
 }
 
index ed08c93..36f66b0 100644 (file)
@@ -29,10 +29,24 @@ sub set_sql {
     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;
index 6ba9310..7a7ea7b 100644 (file)
@@ -15,7 +15,7 @@ sub stringify_self {
         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;
 }
 
index 8855123..14b5367 100644 (file)
@@ -6,6 +6,7 @@ use warnings;
 use base qw/DBIx::Class::PK
             DBIx::Class::Table
             DBIx::Class::SQL
-            DBIx::Class::DB/;
+            DBIx::Class::DB
+            DBIx::Class::AccessorGroup/;
 
 1;
index 1163725..2725ff9 100644 (file)
@@ -17,7 +17,7 @@ sub _ident_values {
   return (map { $self->{_column_data}{$_} } keys %{$self->_primaries});
 }
 
-sub set_primary {
+sub set_primary_key {
   my ($class, @cols) = @_;
   my %pri;
   $pri{$_} = {} for @cols;
@@ -42,4 +42,10 @@ sub retrieve {
   return ($class->search($query))[0];
 }
 
+sub discard_changes {
+  my ($self) = @_;
+  delete $self->{_dirty_columns};
+  $_[0] = $self->retrieve($self->id);
+}
+
 1;
index 511f19b..9873ce4 100644 (file)
@@ -3,7 +3,7 @@ package DBIx::Class::Table;
 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' => {});
 
@@ -16,10 +16,9 @@ sub new {
   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;
 }
 
@@ -76,28 +75,26 @@ sub delete {
   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 {
@@ -109,10 +106,10 @@ 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);
@@ -123,13 +120,18 @@ sub retrieve_from_sql {
   $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;
@@ -156,7 +158,7 @@ sub _select_columns {
 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;
 }
 
@@ -171,4 +173,8 @@ sub _where_from_hash {
   return ($cond, [ values %$query ]);
 }
 
+sub table {
+  shift->_table_name(@_);
+}
+
 1;
index ca1040e..6b3346c 100644 (file)
@@ -95,7 +95,7 @@ ok(!State->find_column('HGLAGAGlAG'), '!find_column HGLAGAGlAG');
 
        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";
 }
index 97505ba..bec54a2 100644 (file)
@@ -238,6 +238,7 @@ is($btaste->Director, $orig_director, 'discard_changes()');
                $btaste3->NumExplodingSheep(13);
        }
        is @warnings, 1, "DESTROY without update warns";
+print join("\n", @warnings);
        Film->autoupdate(0);
 }
 
diff --git a/t/cdbi-t/03-subclassing.t b/t/cdbi-t/03-subclassing.t
new file mode 100644 (file)
index 0000000..75b70d6
--- /dev/null
@@ -0,0 +1,26 @@
+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()';
diff --git a/t/cdbi-t/04-lazy.t b/t/cdbi-t/04-lazy.t
new file mode 100644 (file)
index 0000000..9db9e27
--- /dev/null
@@ -0,0 +1,75 @@
+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($@, $@);
+
diff --git a/t/cdbi-t/08-inheritcols.t b/t/cdbi-t/08-inheritcols.t
new file mode 100644 (file)
index 0000000..c23de9c
--- /dev/null
@@ -0,0 +1,23 @@
+#!/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";
diff --git a/t/cdbi-t/11-triggers.t b/t/cdbi-t/11-triggers.t
new file mode 100644 (file)
index 0000000..9e36c54
--- /dev/null
@@ -0,0 +1,63 @@
+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"});
+}
diff --git a/t/cdbi-t/19-set_sql.t b/t/cdbi-t/19-set_sql.t
new file mode 100644 (file)
index 0000000..bab8f51
--- /dev/null
@@ -0,0 +1,106 @@
+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";
+}
+
diff --git a/t/lib/DBICTest.pm b/t/lib/DBICTest.pm
new file mode 100755 (executable)
index 0000000..8203e60
--- /dev/null
@@ -0,0 +1,169 @@
+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;