Make Class::DBI::Plugin::DeepAbstractSearch work.
Michael G Schwern [Thu, 13 Mar 2008 18:52:14 +0000 (18:52 +0000)]
This required reordering the relationship declarations in the tests to fit
the limitations of CDBICompat.  Also fixing the behavior of sth_to_objects()
and transform_sql().

lib/DBIx/Class/CDBICompat/ColumnGroups.pm
lib/DBIx/Class/CDBICompat/ImaDBI.pm
lib/DBIx/Class/CDBICompat/SQLTransformer.pm [new file with mode: 0644]
t/cdbi-DeepAbstractSearch/01_search.t [new file with mode: 0755]

index f9dd69d..51a40f9 100644 (file)
@@ -63,6 +63,10 @@ sub primary_column {
   return wantarray ? @pri : $pri[0];
 }
 
+sub _essential {
+    return shift->columns("Essential");
+}
+
 sub find_column {
   my ($class, $col) = @_;
   return $col if $class->has_column($col);
index 0a143fa..346c52f 100644 (file)
@@ -7,6 +7,9 @@ use DBIx::ContextualFetch;
 
 use base qw/DBIx::Class/;
 
+__PACKAGE__->mk_classdata('sql_transformer_class' =>
+                          'DBIx::Class::CDBICompat::SQLTransformer');
+
 __PACKAGE__->mk_classdata('_transform_sql_handler_order'
                             => [ qw/TABLE ESSENTIAL JOIN IDENTIFIER/ ] );
 
@@ -88,30 +91,32 @@ sub set_sql {
       sub {
         my ($class, @args) = @_;
         my $sth = $class->$meth;
-        $sth->execute(@args);
-        return $class->sth_to_objects($sth);
+        return $class->sth_to_objects($sth, \@args);
       };
   }
 }
 
 sub sth_to_objects {
-  my ($class, $sth) = @_;
+  my ($class, $sth, $execute_args) = @_;
+
+  $sth->execute(@$execute_args);
+
   my @ret;
   while (my $row = $sth->fetchrow_hashref) {
     push(@ret, $class->inflate_result($class->result_source_instance, $row));
   }
+
   return @ret;
 }
 
 sub transform_sql {
   my ($class, $sql, @args) = @_;
-  my $attrs = { };
-  foreach my $key (@{$class->_transform_sql_handler_order}) {
-    my $h = $class->_transform_sql_handlers->{$key};
-    $sql =~ s/__$key(?:\(([^\)]+)\))?__/$h->($attrs, $class, $1)/eg;
-  }
-  #warn $sql;
-  return sprintf($sql, @args);
+  
+  my $tclass = $class->sql_transformer_class;
+  $class->ensure_class_loaded($tclass);
+  my $t = $tclass->new($class, $sql, @args);
+
+  return sprintf($t->sql, $t->args);
 }
 
 package
diff --git a/lib/DBIx/Class/CDBICompat/SQLTransformer.pm b/lib/DBIx/Class/CDBICompat/SQLTransformer.pm
new file mode 100644 (file)
index 0000000..711c464
--- /dev/null
@@ -0,0 +1,104 @@
+package DBIx::Class::CDBICompat::SQLTransformer;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+DBIx::Class::CDBICompat::SQLTransformer - Transform SQL
+
+=head1 DESCRIPTION
+
+This is a copy of L<Class::DBI::SQL::Transformer> from Class::DBI 3.0.17.
+It is here so we can be compatible with L<Class::DBI> without having it
+installed.
+
+=cut
+
+sub new {
+    my ($me, $caller, $sql, @args) = @_;
+    bless {
+        _caller      => $caller,
+        _sql         => $sql,
+        _args        => [@args],
+        _transformed => 0,
+    } => $me;
+}
+
+sub sql {
+    my $self = shift;
+    $self->_do_transformation if !$self->{_transformed};
+    return $self->{_transformed_sql};
+}
+
+sub args {
+    my $self = shift;
+    $self->_do_transformation if !$self->{_transformed};
+    return @{ $self->{_transformed_args} };
+}
+
+sub _expand_table {
+    my $self = shift;
+    my ($class, $alias) = split /=/, shift, 2;
+    my $caller = $self->{_caller};
+    my $table = $class ? $class->table : $caller->table;
+    $self->{cmap}{ $alias || $table } = $class || ref $caller || $caller;
+    ($alias ||= "") &&= " $alias";
+    return $table . $alias;
+}
+
+sub _expand_join {
+    my $self  = shift;
+    my $joins = shift;
+    my @table = split /\s+/, $joins;
+
+    my $caller = $self->{_caller};
+    my %tojoin = map { $table[$_] => $table[ $_ + 1 ] } 0 .. $#table - 1;
+    my @sql;
+    while (my ($t1, $t2) = each %tojoin) {
+        my ($c1, $c2) = map $self->{cmap}{$_}
+            || $caller->_croak("Don't understand table '$_' in JOIN"), ($t1, $t2);
+
+        my $join_col = sub {
+            my ($c1, $c2) = @_;
+            my $meta = $c1->meta_info('has_a');
+            my ($col) = grep $meta->{$_}->foreign_class eq $c2, keys %$meta;
+            $col;
+        };
+
+        my $col = $join_col->($c1 => $c2) || do {
+            ($c1, $c2) = ($c2, $c1);
+            ($t1, $t2) = ($t2, $t1);
+            $join_col->($c1 => $c2);
+        };
+
+        $caller->_croak("Don't know how to join $c1 to $c2") unless $col;
+        push @sql, sprintf " %s.%s = %s.%s ", $t1, $col, $t2, $c2->primary_column;
+    }
+    return join " AND ", @sql;
+}
+
+sub _do_transformation {
+    my $me     = shift;
+    my $sql    = $me->{_sql};
+    my @args   = @{ $me->{_args} };
+    my $caller = $me->{_caller};
+
+    $sql =~ s/__TABLE\(?(.*?)\)?__/$me->_expand_table($1)/eg;
+    $sql =~ s/__JOIN\((.*?)\)__/$me->_expand_join($1)/eg;
+    $sql =~ s/__ESSENTIAL__/join ", ", $caller->_essential/eg;
+    $sql =~
+        s/__ESSENTIAL\((.*?)\)__/join ", ", map "$1.$_", $caller->_essential/eg;
+    if ($sql =~ /__IDENTIFIER__/) {
+        my $key_sql = join " AND ", map "$_=?", $caller->primary_columns;
+        $sql =~ s/__IDENTIFIER__/$key_sql/g;
+    }
+
+    $me->{_transformed_sql}  = $sql;
+    $me->{_transformed_args} = [@args];
+    $me->{_transformed}      = 1;
+    return 1;
+}
+
+1;
+
diff --git a/t/cdbi-DeepAbstractSearch/01_search.t b/t/cdbi-DeepAbstractSearch/01_search.t
new file mode 100755 (executable)
index 0000000..825b67c
--- /dev/null
@@ -0,0 +1,291 @@
+use strict;
+use Test::More;
+
+BEGIN {
+    eval "use DBD::SQLite";
+    plan $@ ? (skip_all => 'needs DBD::SQLite for testing')
+    : (tests => 19);
+}
+
+my $DB  = "t/testdb";
+unlink $DB if -e $DB;
+
+my @DSN = ("dbi:SQLite:dbname=$DB", '', '', { AutoCommit => 0 });
+
+package Music::DBI;
+use base qw(DBIx::Class::CDBICompat);
+use Class::DBI::Plugin::DeepAbstractSearch;
+__PACKAGE__->connection(@DSN);
+
+my $sql = <<'SQL_END';
+
+---------------------------------------
+-- Artists
+---------------------------------------
+CREATE TABLE artists (
+    id INTEGER NOT NULL PRIMARY KEY,
+    name VARCHAR(32)
+);
+
+INSERT INTO artists VALUES (1, "Willie Nelson");
+INSERT INTO artists VALUES (2, "Patsy Cline");
+
+---------------------------------------
+-- Labels
+---------------------------------------
+CREATE TABLE labels (
+    id INTEGER NOT NULL PRIMARY KEY,
+    name VARCHAR(32)
+);
+
+INSERT INTO labels VALUES (1, "Columbia");
+INSERT INTO labels VALUES (2, "Sony");
+INSERT INTO labels VALUES (3, "Supraphon");
+
+---------------------------------------
+-- CDs
+---------------------------------------
+CREATE TABLE cds (
+    id INTEGER NOT NULL PRIMARY KEY,
+    label INTEGER,
+    artist INTEGER,
+    title VARCHAR(32),
+    year INTEGER
+);
+INSERT INTO cds VALUES (1, 1, 1, "Songs", 2005);
+INSERT INTO cds VALUES (2, 2, 1, "Read Headed Stanger", 2000);
+INSERT INTO cds VALUES (3, 1, 1, "Wanted! The Outlaws", 2004);
+INSERT INTO cds VALUES (4, 2, 1, "The Very Best of Willie Nelson", 1999);
+
+INSERT INTO cds VALUES (5, 1, 2, "12 Greates Hits", 1999);
+INSERT INTO cds VALUES (6, 2, 2, "Sweet Dreams", 1995);
+INSERT INTO cds VALUES (7, 3, 2, "The Best of Patsy Cline", 1991);
+
+---------------------------------------
+-- Tracks
+---------------------------------------
+CREATE TABLE tracks (
+    id INTEGER NOT NULL PRIMARY KEY,
+    cd INTEGER,
+    position INTEGER,
+    title VARCHAR(32)
+);
+INSERT INTO tracks VALUES (1, 1, 1, "Songs: Track 1");
+INSERT INTO tracks VALUES (2, 1, 2, "Songs: Track 2");
+INSERT INTO tracks VALUES (3, 1, 3, "Songs: Track 3");
+INSERT INTO tracks VALUES (4, 1, 4, "Songs: Track 4");
+
+INSERT INTO tracks VALUES (5, 2, 1, "Read Headed Stanger: Track 1");
+INSERT INTO tracks VALUES (6, 2, 2, "Read Headed Stanger: Track 2");
+INSERT INTO tracks VALUES (7, 2, 3, "Read Headed Stanger: Track 3");
+INSERT INTO tracks VALUES (8, 2, 4, "Read Headed Stanger: Track 4");
+
+INSERT INTO tracks VALUES (9, 3, 1, "Wanted! The Outlaws: Track 1");
+INSERT INTO tracks VALUES (10, 3, 2, "Wanted! The Outlaws: Track 2");
+
+INSERT INTO tracks VALUES (11, 4, 1, "The Very Best of Willie Nelson: Track 1");
+INSERT INTO tracks VALUES (12, 4, 2, "The Very Best of Willie Nelson: Track 2");
+INSERT INTO tracks VALUES (13, 4, 3, "The Very Best of Willie Nelson: Track 3");
+INSERT INTO tracks VALUES (14, 4, 4, "The Very Best of Willie Nelson: Track 4");
+INSERT INTO tracks VALUES (15, 4, 5, "The Very Best of Willie Nelson: Track 5");
+INSERT INTO tracks VALUES (16, 4, 6, "The Very Best of Willie Nelson: Track 6");
+
+INSERT INTO tracks VALUES (17, 5, 1, "12 Greates Hits: Track 1");
+INSERT INTO tracks VALUES (18, 5, 2, "12 Greates Hits: Track 2");
+INSERT INTO tracks VALUES (19, 5, 3, "12 Greates Hits: Track 3");
+INSERT INTO tracks VALUES (20, 5, 4, "12 Greates Hits: Track 4");
+
+INSERT INTO tracks VALUES (21, 6, 1, "Sweet Dreams: Track 1");
+INSERT INTO tracks VALUES (22, 6, 2, "Sweet Dreams: Track 2");
+INSERT INTO tracks VALUES (23, 6, 3, "Sweet Dreams: Track 3");
+INSERT INTO tracks VALUES (24, 6, 4, "Sweet Dreams: Track 4");
+
+INSERT INTO tracks VALUES (25, 7, 1, "The Best of Patsy Cline: Track 1");
+INSERT INTO tracks VALUES (26, 7, 2, "The Best of Patsy Cline: Track 2");
+
+SQL_END
+
+foreach my $statement (split /;/, $sql) {
+    $statement =~ s/^\s*//gs;
+    $statement =~ s/\s*$//gs;
+    next unless $statement;
+    Music::DBI->db_Main->do($statement) or die "$@ $!";
+}
+
+Music::DBI->dbi_commit;
+
+package Music::Artist;
+use base 'Music::DBI';
+Music::Artist->table('artists');
+Music::Artist->columns(All => qw/id name/);
+
+
+package Music::Label;
+use base 'Music::DBI';
+Music::Label->table('labels');
+Music::Label->columns(All => qw/id name/);
+
+package Music::CD;
+use base 'Music::DBI';
+Music::CD->table('cds');
+Music::CD->columns(All => qw/id label artist title year/);
+
+
+package Music::Track;
+use base 'Music::DBI';
+Music::Track->table('tracks');
+Music::Track->columns(All => qw/id cd position title/);
+
+Music::Artist->has_many(cds => 'Music::CD');
+Music::Label->has_many(cds => 'Music::CD');
+Music::CD->has_many(tracks => 'Music::Track');
+Music::CD->has_a(artist => 'Music::Artist');
+Music::CD->has_a(label => 'Music::Label');
+Music::Track->has_a(cd => 'Music::CD');
+
+package main;
+
+{
+    my $where = { };
+    my $attr;
+    my @artists = Music::Artist->deep_search_where($where, $attr);
+    is_deeply [ sort @artists ], [ 1, 2 ],      "all without order";
+}
+
+{
+    my $where = { };
+    my $attr = { order_by => 'name' };
+    my @artists = Music::Artist->deep_search_where($where, $attr);
+    is_deeply \@artists, [ 2, 1 ],      "all with ORDER BY name";
+}
+
+{
+    my $where = { };
+    my $attr = { order_by => 'name DESC' };
+    my @artists = Music::Artist->deep_search_where($where, $attr);
+    is_deeply \@artists, [ 1, 2 ],      "all with ORDER BY name DESC";
+}
+
+{
+    my $where = { name => { -like => 'Patsy Cline' }, };
+    my $attr;
+    my @artists = Music::Artist->deep_search_where($where, $attr);
+    is_deeply \@artists, [ 2 ],         "simple search";
+}
+
+{
+    my $where = { 'artist.name' => 'Patsy Cline' };
+    my $attr = { } ;
+    my @cds = Music::CD->deep_search_where($where, $attr);
+    is_deeply [ sort @cds ], [ 5, 6, 7 ],   "Patsy's CDs";
+}
+
+{
+    my $where = { 'artist.name' => 'Patsy Cline' };
+    my $attr = { order_by => "title" } ;
+    my @cds = Music::CD->deep_search_where($where, $attr);
+    is_deeply [ @cds ], [ 5, 6, 7 ],        "Patsy's CDs by title";
+
+    my $count = Music::CD->count_deep_search_where($where);
+    is_deeply $count, 3,        "count Patsy's CDs by title";
+}
+
+{
+    my $where = { 'cd.title' => { -like => 'S%' }, };
+    my $attr = { order_by => "cd.title, title" } ;
+    my @cds = Music::Track->deep_search_where($where, $attr);
+    is_deeply [ @cds ], [1, 2, 3, 4, 21, 22, 23, 24 ],      "Tracks from CDs whose name starts with 'S'";
+}
+
+{
+    my $where = {
+        'cd.artist.name' => { -like => 'W%' },
+        'cd.year' => { '>' => 2000 },
+        'position' => { '<' => 3 }
+        };
+    my $attr = { order_by => "cd.title DESC, title" } ;
+    my @cds = Music::Track->deep_search_where($where, $attr);
+    is_deeply [ @cds ], [ 9, 10, 1, 2 ],        "First 2 tracks from W's albums after 2000 ";
+
+    my $count = Music::Track->count_deep_search_where($where);
+    is_deeply $count, 4,        "Count First 2 tracks from W's albums after 2000";
+}
+
+{
+    my $where = {
+        'cd.artist.name' => { -like => 'W%' },
+        'cd.year' => { '>' => 2000 },
+        'position' => { '<' => 3 }
+        };
+    my $attr = { order_by => [ 'cd.title DESC' , 'title' ] } ;
+    my @cds = Music::Track->deep_search_where($where, $attr);
+    is_deeply [ @cds ], [ 9, 10, 1, 2 ],        "First 2 tracks from W's albums after 2000, array ref order ";
+
+    my $count = Music::Track->count_deep_search_where($where);
+    is_deeply $count, 4,        "Count First 2 tracks from W's albums after 2000, array ref order";
+}
+
+{
+    my $where = { 'cd.title' => [ -and => { -like => '%o%' }, { -like => '%W%' } ] };
+    my $attr = { order_by => [ 'cd.id' ] } ;
+
+    my @tracks = Music::Track->deep_search_where($where, $attr);
+    is_deeply [ @tracks ], [ 3, 3, 4, 4, 4, 4, 4, 4 ],      "Tracks from CD titles containing 'o' AND 'W'";
+}
+
+{
+    my $where = { 'cd.year' => [ 1995, 1999 ] };
+    my $attr = { order_by => [ 'cd.id' ] } ;
+
+    my @tracks = Music::Track->deep_search_where($where, $attr);
+    is_deeply [ @tracks ], [ 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 6, 6, 6, 6 ],
+            "Tracks from CDs from 1995, 1999";
+}
+
+{
+    my $where = { 'cd.year' => { -in => [ 1995, 1999 ] } };
+    my $attr = { order_by => [ 'cd.id' ] } ;
+
+    my @tracks = Music::Track->deep_search_where($where, $attr);
+    is_deeply [ @tracks ], [ 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 6, 6, 6, 6 ],
+            "Tracks from CDs in 1995, 1999";
+}
+
+{
+    my $where = { -and => [ 'cd.year' => [ 1995, 1999 ], position => { '<=', 2 } ] };
+    my $attr = { order_by => [ 'cd.id' ] } ;
+
+    my @tracks = Music::Track->deep_search_where($where, $attr);
+    is_deeply [ @tracks ], [ 4, 4, 5, 5, 6, 6 ],
+            "First 2 tracks Tracks from CDs from 1995, 1999";
+}
+
+{
+    my $where = { -and => [ 'cd.year' => { -in => [ 1995, 1999 ] }, position => { '<=', 2 } ] };
+    my $attr = { order_by => [ 'cd.id' ] } ;
+
+    my @tracks = Music::Track->deep_search_where($where, $attr);
+    is_deeply [ @tracks ], [ 4, 4, 5, 5, 6, 6 ],
+            "First 2 tracks Tracks from CDs in 1995, 1999";
+}
+
+{
+    my $where = { 'label.name' => { -in => [ 'Sony', 'Supraphon', 'Bogus' ] } };
+    my $attr = { order_by => [ 'id' ] } ;
+
+    my @cds = Music::CD->deep_search_where($where, $attr);
+    is_deeply [ @cds ], [ 2, 4, 6, 7 ],
+            "CDs from Sony or Supraphon";
+}
+
+{
+    my $where = { 'label.name' => [ 'Sony', 'Supraphon', 'Bogus' ] };
+    my $attr = { order_by => [ 'id' ] } ;
+
+    my @cds = Music::CD->deep_search_where($where, $attr);
+    is_deeply [ @cds ], [ 2, 4, 6, 7 ],
+            "CDs from Sony or Supraphon";
+}
+
+END { unlink $DB if -e $DB }
+