From: Luke Saunders <luke.saunders@gmail.com>
Date: Thu, 6 Apr 2006 17:36:57 +0000 (+0000)
Subject: fixed multiple column count distincts in SQLite and Oracle
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=286f32b3cfaa7a96e3626d2b13a33302390e22bd;p=dbsrgits%2FDBIx-Class-Historic.git

fixed multiple column count distincts in SQLite and Oracle
---

diff --git a/lib/DBIx/Class.pm b/lib/DBIx/Class.pm
index 323c410..488a5c2 100644
--- a/lib/DBIx/Class.pm
+++ b/lib/DBIx/Class.pm
@@ -222,6 +222,8 @@ scotty: Scotty Allen <scotty@scottyallen.com>
 
 sszabo: Stephan Szabo <sszabo@bigpanda.com>
 
+captainL: Luke Saunders <luke.saunders@gmail.com>
+
 Todd Lipcon
 
 wdh: Will Hawes
diff --git a/lib/DBIx/Class/Manual/Cookbook.pod b/lib/DBIx/Class/Manual/Cookbook.pod
index 61671d4..ed00d46 100644
--- a/lib/DBIx/Class/Manual/Cookbook.pod
+++ b/lib/DBIx/Class/Manual/Cookbook.pod
@@ -138,6 +138,8 @@ any of your aliases using either of these:
     }
   );
 
+  my $count = $rs->next->get_column('count');
+
 =head3 SELECT COUNT(DISTINCT colname)
 
   my $rs = $schema->resultset('Foo')->search(
diff --git a/lib/DBIx/Class/Storage/DBI/MultiDistinctEmulation.pm b/lib/DBIx/Class/Storage/DBI/MultiDistinctEmulation.pm
new file mode 100644
index 0000000..f38c03b
--- /dev/null
+++ b/lib/DBIx/Class/Storage/DBI/MultiDistinctEmulation.pm
@@ -0,0 +1,51 @@
+package DBIx::Class::Storage::DBI::MultiDistinctEmulation;
+
+use strict;
+use warnings;
+
+use base qw/DBIx::Class::Storage::DBI/;
+
+sub _select {
+  my ($self, $ident, $select, $condition, $attrs) = @_;
+
+  # hack to make count distincts with multiple columns work in SQLite and Oracle
+  if (ref $select eq 'ARRAY') { 
+      @{$select} = map {$self->replace_distincts($_)} @{$select};
+  } else { 
+      $select = $self->replace_distincts($select);
+  }
+
+  return $self->next::method($ident, $select, $condition, $attrs);
+}
+
+sub replace_distincts {
+    my ($self, $select) = @_;
+
+    $select->{count}->{distinct} = join("||", @{$select->{count}->{distinct}}) 
+	if (ref $select eq 'HASH' && $select->{count} && ref $select->{count} eq 'HASH' && 
+	    $select->{count}->{distinct} && ref $select->{count}->{distinct} eq 'ARRAY');
+
+    return $select;
+}
+
+1;
+
+=head1 NAME 
+
+DBIx::Class::Storage::DBI::Retarded - Some databases can't handle count distincts with multiple cols. They should use base on this.
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+This class allows count distincts with multiple columns for retarded databases (Oracle and SQLite)
+
+=head1 AUTHORS
+
+Luke Saunders <luke.saunders@gmail.com>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
diff --git a/lib/DBIx/Class/Storage/DBI/Oracle.pm b/lib/DBIx/Class/Storage/DBI/Oracle.pm
index 53d657a..cd5449b 100644
--- a/lib/DBIx/Class/Storage/DBI/Oracle.pm
+++ b/lib/DBIx/Class/Storage/DBI/Oracle.pm
@@ -5,7 +5,7 @@ use warnings;
 
 use Carp qw/croak/;
 
-use base qw/DBIx::Class::Storage::DBI/;
+use base qw/DBIx::Class::Storage::DBI::MultiDistinctEmulation/;
 
 # __PACKAGE__->load_components(qw/PK::Auto/);
 
diff --git a/lib/DBIx/Class/Storage/DBI/SQLite.pm b/lib/DBIx/Class/Storage/DBI/SQLite.pm
index 6b7e749..091b5e7 100644
--- a/lib/DBIx/Class/Storage/DBI/SQLite.pm
+++ b/lib/DBIx/Class/Storage/DBI/SQLite.pm
@@ -3,7 +3,7 @@ package DBIx::Class::Storage::DBI::SQLite;
 use strict;
 use warnings;
 
-use base qw/DBIx::Class::Storage::DBI/;
+use base qw/DBIx::Class::Storage::DBI::MultiDistinctEmulation/;
 
 sub last_insert_id {
   return $_[0]->dbh->func('last_insert_rowid');
diff --git a/t/run/01core.tl b/t/run/01core.tl
index 0bc257a..f5960f6 100644
--- a/t/run/01core.tl
+++ b/t/run/01core.tl
@@ -1,7 +1,7 @@
 sub run_tests {
 my $schema = shift;
 
-plan tests => 43; 
+plan tests => 44; 
 
 my @art = $schema->resultset("Artist")->search({ }, { order_by => 'name DESC'});
 
@@ -136,6 +136,15 @@ my $distinct_rs = $schema->resultset("CD")->search($search, { join => 'tags', di
 
 cmp_ok($distinct_rs->all, '==', 4, 'DISTINCT search with OR ok');
 
+my $tcount = $schema->resultset("Track")->search(
+    {},
+    {
+	select => {count => {distinct => ['position', 'title']}},
+	as => ['count']
+    }
+  );
+cmp_ok($tcount->next->get_column('count'), '==', 13, 'multiple column COUNT DISTINCT ok');
+
 my $tag_rs = $schema->resultset('Tag')->search(
                [ { 'me.tag' => 'Cheesy' }, { 'me.tag' => 'Blue' } ]);
 
diff --git a/t/run/13oracle.tl b/t/run/13oracle.tl
index 278e663..f38b767 100644
--- a/t/run/13oracle.tl
+++ b/t/run/13oracle.tl
@@ -7,7 +7,7 @@ plan skip_all, 'Set $ENV{DBICTEST_ORA_DSN}, _USER and _PASS to run this test. '
   'Warning: This test drops and creates tables called \'artist\', \'cd\' and \'track\''
   unless ($dsn && $user && $pass);
 
-plan tests => 5;
+plan tests => 6;
 
 DBICTest::Schema->compose_connection('OraTest' => $dsn, $user, $pass);
 
@@ -56,6 +56,17 @@ my $tjoin = OraTest::Track->search({ 'me.title' => 'Track1'},
 
 is($tjoin->next->title, 'Track1', "ambiguous column ok");
 
+# check count distinct with multiple columns
+my $other_track = OraTest::Track->create({ trackid => 2, cd => 1, position => 1, title => 'Track2' });
+my $tcount = OraTest::Track->search(
+    {},
+    {
+	select => [{count => {distinct => ['position', 'title']}}],
+	as => ['count']
+    }
+  );
+
+is($tcount->next->get_column('count'), 2, "multiple column select distinct ok");
 
 # test LIMIT support
 for (1..6) {