From: Matt S Trout <mst@shadowcat.co.uk>
Date: Thu, 29 Dec 2005 22:44:21 +0000 (+0000)
Subject: Hack around a stupid SQL::Abstract bug and add GROUP BY support
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=54540863adce71e931685a37d33e37650e5feb5e;p=dbsrgits%2FDBIx-Class-Historic.git

Hack around a stupid SQL::Abstract bug and add GROUP BY support
---

diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index 9c615d7..e52e179 100644
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -58,6 +58,7 @@ sub new {
     }
     push(@{$attrs->{from}}, $source->result_class->_resolve_join($attrs->{join}, 'me'));
   }
+  $attrs->{group_by} ||= $attrs->{select} if delete $attrs->{distinct};
   foreach my $pre (@{$attrs->{prefetch} || []}) {
     push(@{$attrs->{from}}, $source->result_class->_resolve_join($pre, 'me'))
       unless $seen{$pre};
@@ -244,9 +245,11 @@ on the resultset and counts the results of that.
 sub count {
   my $self = shift;
   return $self->search(@_)->count if @_ && defined $_[0];
+  die "Unable to ->count with a GROUP BY" if defined $self->{attrs}{group_by};
   unless ($self->{count}) {
     my $attrs = { %{ $self->{attrs} },
-                  select => [ 'COUNT(*)' ], as => [ 'count' ] };
+                  select => { 'count' => '*' },
+                  as => [ 'count' ] };
     # offset and order by are not needed to count, page, join and prefetch
     # will get in the way (add themselves to from again ...)
     delete $attrs->{$_} for qw/offset order_by page join prefetch/;
@@ -409,6 +412,15 @@ for an unpaged resultset.
 
 For a paged resultset, how many rows per page
 
+=head2 group_by
+
+A list of columns to group by (note that 'count' doesn't work on grouped
+resultsets)
+
+=head2 distinct
+
+Set to 1 to group by all columns
+
 =cut
 
 1;
diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm
index 557e036..e2643f0 100644
--- a/lib/DBIx/Class/Schema.pm
+++ b/lib/DBIx/Class/Schema.pm
@@ -29,7 +29,7 @@ in My/Schema/Foo.pm
 
   use base qw/DBIx::Class/;
 
-  __PACKAGE__->load_components(qw/Core PK::Auto::Pg/); # for example
+  __PACKAGE__->load_components(qw/PK::Auto::Pg Core/); # for example
   __PACKAGE__->table('foo');
   ...
 
@@ -146,15 +146,21 @@ as well as dbh connection info, and creates a L<DBIx::Class::DB> class as
 well as subclasses for each of your database classes in this namespace, using
 this connection.
 
-It will also setup a ->table method on the target class, which lets you
+It will also setup a ->class method on the target class, which lets you
 resolve database classes based on the schema component name, for example
 
-  MyApp::DB->table('Foo') # returns MyApp::DB::Foo, 
+  MyApp::DB->class('Foo') # returns MyApp::DB::Foo, 
                           # which ISA MyApp::Schema::Foo
 
 This is the recommended API for accessing Schema generated classes, and 
 using it might give you instant advantages with future versions of DBIC.
 
+WARNING: Loading components into Schema classes after compose_connection
+may not cause them to be seen by the classes in your target namespace due
+to the dispatch table approach used by Class::C3. If you do this you may find
+you need to call Class::C3->reinitialize() afterwards to get the behaviour
+you expect.
+
 =cut
 
 sub compose_connection {
diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index ee944ad..5c858ec 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -12,6 +12,55 @@ package DBIC::SQL::Abstract; # Temporary. Merge upstream.
 
 use base qw/SQL::Abstract::Limit/;
 
+sub select {
+  my ($self, $table, $fields, $where, $order, @rest) = @_;
+  @rest = (-1) unless defined $rest[0];
+  $self->SUPER::select($table, $self->_recurse_fields($fields), 
+                         $where, $order, @rest);
+}
+
+sub _emulate_limit {
+  my $self = shift;
+  if ($_[3] == -1) {
+    return $_[1].$self->_order_by($_[2]);
+  } else {
+    return $self->SUPER::_emulate_limit(@_);
+  }
+}
+
+sub _recurse_fields {
+  my ($self, $fields) = @_;
+  my $ref = ref $fields;
+  return $self->_quote($fields) unless $ref;
+  return $$fields if $ref eq 'SCALAR';
+
+  if ($ref eq 'ARRAY') {
+    return join(', ', map { $self->_recurse_fields($_) } @$fields);
+  } elsif ($ref eq 'HASH') {
+    foreach my $func (keys %$fields) {
+      return $self->_sqlcase($func)
+        .'( '.$self->_recurse_fields($fields->{$func}).' )';
+    }
+  }
+}
+
+sub _order_by {
+  my $self = shift;
+  my $ret = '';
+  if (ref $_[0] eq 'HASH') {
+    if (defined $_[0]->{group_by}) {
+      $ret = $self->_sqlcase(' group by ')
+               .$self->_recurse_fields($_[0]->{group_by});
+    }
+    if (defined $_[0]->{order_by}) {
+      $ret .= $self->SUPER::_order_by($_[0]->{order_by});
+    }
+  } else {
+    $ret = $self->SUPER::_order_by(@_);
+  }
+  return $ret;
+}
+
 sub _table {
   my ($self, $from) = @_;
   if (ref $from eq 'ARRAY') {
@@ -30,13 +79,13 @@ sub _recurse_from {
   foreach my $j (@join) {
     my ($to, $on) = @$j;
 
-	# check whether a join type exists
-	my $join_clause = '';
-	if (ref($to) eq 'HASH' and exists($to->{-join_type})) {
-		$join_clause = ' '.uc($to->{-join_type}).' JOIN ';
-	} else {
-		$join_clause = ' JOIN ';
-	}
+    # check whether a join type exists
+    my $join_clause = '';
+    if (ref($to) eq 'HASH' and exists($to->{-join_type})) {
+      $join_clause = ' '.uc($to->{-join_type}).' JOIN ';
+    } else {
+      $join_clause = ' JOIN ';
+    }
     push(@sqlf, $join_clause);
 
     if (ref $to eq 'ARRAY') {
@@ -51,16 +100,16 @@ sub _recurse_from {
 
 sub _make_as {
   my ($self, $from) = @_;
-  	return join(' ', map { $self->_quote($_) }
+  return join(' ', map { (ref $_ eq 'SCALAR' ? $$_ : $self->_quote($_)) }
                            reverse each %{$self->_skip_options($from)});
 }
 
 sub _skip_options {
-	my ($self, $hash) = @_;
-	my $clean_hash = {};
-	$clean_hash->{$_} = $hash->{$_}
-		for grep {!/^-/} keys %$hash;
-	return $clean_hash;
+  my ($self, $hash) = @_;
+  my $clean_hash = {};
+  $clean_hash->{$_} = $hash->{$_}
+    for grep {!/^-/} keys %$hash;
+  return $clean_hash;
 }
 
 sub _join_condition {
@@ -209,6 +258,10 @@ sub _select {
   if (ref $condition eq 'SCALAR') {
     $order = $1 if $$condition =~ s/ORDER BY (.*)$//i;
   }
+  if (exists $attrs->{group_by}) {
+    $order = { group_by => $attrs->{group_by},
+               ($order ? (order_by => $order) : ()) };
+  }
   my @args = ('select', $attrs->{bind}, $ident, $select, $condition, $order);
   if ($attrs->{software_limit} ||
       $self->sql_maker->_default_limit_syntax eq "GenericSubQ") {
diff --git a/lib/DBIx/Class/Validation.pm b/lib/DBIx/Class/Validation.pm
index 4b83067..a3b7171 100644
--- a/lib/DBIx/Class/Validation.pm
+++ b/lib/DBIx/Class/Validation.pm
@@ -7,7 +7,8 @@ use base qw( DBIx::Class );
 use Carp qw( croak );
 use English qw( -no_match_vars );
 
-local $^W = 0; # Silence C:D:I redefined sub errors.
+#local $^W = 0; # Silence C:D:I redefined sub errors.
+# Switched to C::D::Accessor which doesn't do this. Hate hate hate hate.
 
 our $VERSION = '0.01';
 
diff --git a/t/19quotes.t b/t/19quotes.t
index abc1283..79d02ee 100644
--- a/t/19quotes.t
+++ b/t/19quotes.t
@@ -19,7 +19,7 @@ DBICTest::_db->storage->sql_maker->{'quote_char'} = q!'!;
 DBICTest::_db->storage->sql_maker->{'name_sep'} = '.';
 
 my $rs = DBICTest::CD->search(
-           { 'year' => 2001, 'artist.name' => 'Caterwauler McCrae' },
+           { 'me.year' => 2001, 'artist.name' => 'Caterwauler McCrae' },
            { join => 'artist' });
 
 cmp_ok( $rs->count, '==', 1, "join with fields quoted");
diff --git a/t/lib/DBICTest/Schema.pm b/t/lib/DBICTest/Schema.pm
index dc4002e..d2a7e5b 100644
--- a/t/lib/DBICTest/Schema.pm
+++ b/t/lib/DBICTest/Schema.pm
@@ -22,7 +22,7 @@ __PACKAGE__->load_classes(qw/
     '#dummy',
     'SelfRef',
   ),
-  qw/SelfRefAlias/
+  qw/SelfRefAlias CDWithArtist/
 );
 
 1;
diff --git a/t/lib/DBICTest/Schema/BasicRels.pm b/t/lib/DBICTest/Schema/BasicRels.pm
index 535b619..f3483b5 100644
--- a/t/lib/DBICTest/Schema/BasicRels.pm
+++ b/t/lib/DBICTest/Schema/BasicRels.pm
@@ -5,7 +5,7 @@ use base 'DBIx::Class::Core';
 DBICTest::Schema::Artist->add_relationship(
     cds => 'DBICTest::Schema::CD',
     { 'foreign.artist' => 'self.artistid' },
-    { order_by => 'year' }
+    { order_by => 'year', join_type => 'LEFT', cascade_delete => 1 }
 );
 DBICTest::Schema::Artist->add_relationship(
     twokeys => 'DBICTest::Schema::TwoKeys',
@@ -22,11 +22,13 @@ DBICTest::Schema::CD->add_relationship(
 );
 DBICTest::Schema::CD->add_relationship(
     tracks => 'DBICTest::Schema::Track',
-    { 'foreign.cd' => 'self.cdid' }
+    { 'foreign.cd' => 'self.cdid' },
+    { join_type => 'LEFT', cascade_delete => 1 }
 );
 DBICTest::Schema::CD->add_relationship(
     tags => 'DBICTest::Schema::Tag',
-    { 'foreign.cd' => 'self.cdid' }
+    { 'foreign.cd' => 'self.cdid' },
+    { join_type => 'LEFT', cascade_delete => 1 }
 );
 #DBICTest::Schema::CD->might_have(liner_notes => 'DBICTest::Schema::LinerNotes' => qw/notes/);
 DBICTest::Schema::CD->add_relationship(
diff --git a/t/run/01core.tl b/t/run/01core.tl
index a6f5b88..95138a1 100644
--- a/t/run/01core.tl
+++ b/t/run/01core.tl
@@ -1,6 +1,6 @@
 sub run_tests {
 
-plan tests => 29; 
+plan tests => 31; 
 
 my @art = DBICTest->class("Artist")->search({ }, { order_by => 'name DESC'});
 
@@ -114,6 +114,16 @@ ok $@, $@;
 
 is(DBICTest->class("Artist")->field_name_for->{name}, 'artist name', 'mk_classdata usage ok');
 
+my $search = [ { 'tags.tag' => 'Cheesy' }, { 'tags.tag' => 'Blue' } ];
+
+my $rs = DBICTest->class("CD")->search($search, { join => 'tags' });
+
+cmp_ok($rs->all, '==', 5, 'Search with OR ok');
+
+$rs = DBICTest->class("CD")->search($search, { join => 'tags', distinct => 1 });
+
+cmp_ok($rs->all, '==', 4, 'DISTINCT search with OR ok');
+
 }
 
 1;