X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSet.pm;h=65282d3eea5f815fb4a85864c6db1af0c68e0156;hb=5ef3e508fa20d477b62406146cdca0ae658c10dd;hp=4546c1f8c8082b0a973ca60ea2b067d0e2d65baf;hpb=ae1c90a17bc0b62714b668709afa6fafaa459924;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index 4546c1f..65282d3 100644
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -2,7 +2,6 @@ package DBIx::Class::ResultSet;
 
 use strict;
 use warnings;
-use Carp qw/croak/;
 use overload
         '0+'     => 'count',
         'bool'   => sub { 1; },
@@ -10,6 +9,10 @@ use overload
 use Data::Page;
 use Storable;
 
+use base qw/DBIx::Class/;
+__PACKAGE__->load_components(qw/AccessorGroup/);
+__PACKAGE__->mk_group_accessors('simple' => 'result_source');
+
 =head1 NAME
 
 DBIx::Class::ResultSet - Responsible for fetching and creating resultset.
@@ -75,8 +78,13 @@ sub new {
     $attrs->{select} = [ map { m/\./ ? $_ : "${alias}.$_" } @cols ];
   }
   $attrs->{as} ||= [ map { m/^$alias\.(.*)$/ ? $1 : $_ } @{$attrs->{select}} ];
+  if (my $include = delete $attrs->{include_columns}) {
+    push(@{$attrs->{select}}, @$include);
+    push(@{$attrs->{as}}, map { m/([^\.]+)$/; $1; } @$include);
+  }
   #use Data::Dumper; warn Dumper(@{$attrs}{qw/select as/});
   $attrs->{from} ||= [ { $alias => $source->from } ];
+  $attrs->{seen_join} ||= {};
   if (my $join = delete $attrs->{join}) {
     foreach my $j (ref $join eq 'ARRAY'
               ? (@{$join}) : ($join)) {
@@ -86,7 +94,7 @@ sub new {
         $seen{$j} = 1;
       }
     }
-    push(@{$attrs->{from}}, $source->resolve_join($join, $attrs->{alias}));
+    push(@{$attrs->{from}}, $source->resolve_join($join, $attrs->{alias}, $attrs->{seen_join}));
   }
   $attrs->{group_by} ||= $attrs->{select} if delete $attrs->{distinct};
 
@@ -103,11 +111,10 @@ sub new {
         push(@{$attrs->{from}}, $source->resolve_join($p, $attrs->{alias}))
             unless $seen{$p};
       }
-      my @cols = ();
-      push @cols, $source->resolve_prefetch($p, $attrs->{alias});
+      my @prefetch = $source->resolve_prefetch($p, $attrs->{alias});
       #die Dumper \@cols;
-      push(@{$attrs->{select}}, @cols);
-      push(@{$attrs->{as}}, @cols);
+      push(@{$attrs->{select}}, map { $_->[0] } @prefetch);
+      push(@{$attrs->{as}}, map { $_->[1] } @prefetch);
     }
   }
 
@@ -117,7 +124,7 @@ sub new {
     $attrs->{offset} += ($attrs->{rows} * ($attrs->{page} - 1));
   }
   my $new = {
-    source => $source,
+    result_source => $source,
     cond => $attrs->{where},
     from => $attrs->{from},
     count => undef,
@@ -161,7 +168,7 @@ sub search {
     $attrs->{where} = $where;
   }
 
-  my $rs = (ref $self)->new($self->{source}, $attrs);
+  my $rs = (ref $self)->new($self->result_source, $attrs);
 
   return (wantarray ? $rs->all : $rs);
 }
@@ -208,32 +215,32 @@ sub find {
   my ($self, @vals) = @_;
   my $attrs = (@vals > 1 && ref $vals[$#vals] eq 'HASH' ? pop(@vals) : {});
 
-  my @cols = $self->{source}->primary_columns;
+  my @cols = $self->result_source->primary_columns;
   if (exists $attrs->{key}) {
-    my %uniq = $self->{source}->unique_constraints;
+    my %uniq = $self->result_source->unique_constraints;
     $self->( "Unknown key " . $attrs->{key} . " on " . $self->name )
       unless exists $uniq{$attrs->{key}};
     @cols = @{ $uniq{$attrs->{key}} };
   }
   #use Data::Dumper; warn Dumper($attrs, @vals, @cols);
-  $self->{source}->result_class->throw( "Can't find unless a primary key or unique constraint is defined" )
+  $self->throw_exception( "Can't find unless a primary key or unique constraint is defined" )
     unless @cols;
 
   my $query;
   if (ref $vals[0] eq 'HASH') {
-    $query = $vals[0];
+    $query = { %{$vals[0]} };
   } elsif (@cols == @vals) {
     $query = {};
     @{$query}{@cols} = @vals;
   } else {
     $query = {@vals};
   }
+  foreach (keys %$query) {
+    next if m/\./;
+    $query->{$self->{attrs}{alias}.'.'.$_} = delete $query->{$_};
+  }
   #warn Dumper($query);
-  # Useless -> disabled
-  #$self->{source}->result_class->throw( "Can't find unless all primary keys are specified" )
-  #  unless (keys %$query >= @pk); # If we check 'em we run afoul of uc/lc
-                                  # column names etc. Not sure what to do yet
-  return $self->search($query)->next;
+  return $self->search($query,$attrs)->next;
 }
 
 =head2 search_related
@@ -247,15 +254,18 @@ records.
 
 sub search_related {
   my ($self, $rel, @rest) = @_;
-  my $rel_obj = $self->{source}->relationship_info($rel);
-  $self->{source}->result_class->throw(
+  my $rel_obj = $self->result_source->relationship_info($rel);
+  $self->throw_exception(
     "No such relationship ${rel} in search_related")
       unless $rel_obj;
   my $rs = $self->search(undef, { join => $rel });
-  return $self->{source}->schema->resultset($rel_obj->{class}
+  my $alias = ($rs->{attrs}{seen_join}{$rel} > 1
+                ? join('_', $rel, $rs->{attrs}{seen_join}{$rel})
+                : $rel);
+  return $self->result_source->schema->resultset($rel_obj->{class}
            )->search( undef,
              { %{$rs->{attrs}},
-               alias => $rel,
+               alias => $alias,
                select => undef(),
                as => undef() }
            )->search(@rest);
@@ -269,10 +279,10 @@ Returns a storage-driven cursor to the given resultset.
 
 sub cursor {
   my ($self) = @_;
-  my ($source, $attrs) = @{$self}{qw/source attrs/};
+  my ($attrs) = $self->{attrs};
   $attrs = { %$attrs };
   return $self->{cursor}
-    ||= $source->storage->select($self->{from}, $attrs->{select},
+    ||= $self->result_source->storage->select($self->{from}, $attrs->{select},
           $attrs->{where},$attrs);
 }
 
@@ -309,7 +319,7 @@ sub slice {
   $attrs->{offset} ||= 0;
   $attrs->{offset} += $min;
   $attrs->{rows} = ($max ? ($max - $min + 1) : 1);
-  my $slice = (ref $self)->new($self->{source}, $attrs);
+  my $slice = (ref $self)->new($self->result_source, $attrs);
   return (wantarray ? $slice->all : $slice);
 }
 
@@ -349,33 +359,68 @@ sub _construct_object {
     $target->[0]->{$col} = shift @row;
   }
   #use Data::Dumper; warn Dumper(\@as, $info);
-  my $new = $self->{source}->result_class->inflate_result(
-              $self->{source}, @$info);
+  my $new = $self->result_source->result_class->inflate_result(
+              $self->result_source, @$info);
   $new = $self->{attrs}{record_filter}->($new)
     if exists $self->{attrs}{record_filter};
   return $new;
 }
 
+=head2 result_source 
+
+Returns a reference to the result source for this recordset.
+
+=cut
+
+
 =head2 count
 
 Performs an SQL C<COUNT> with the same query as the resultset was built
 with to find the number of elements. If passed arguments, does a search
 on the resultset and counts the results of that.
 
+Note: When using C<count> with C<group_by>, L<DBIX::Class> emulates C<GROUP BY>
+using C<COUNT( DISTINCT( columns ) )>. Some databases (notably SQLite) do
+not support C<DISTINCT> with multiple columns. If you are using such a
+database, you should only use columns from the main table in your C<group_by>
+clause.
+
 =cut
 
 sub count {
   my $self = shift;
   return $self->search(@_)->count if @_ && defined $_[0];
-  croak "Unable to ->count with a GROUP BY" if defined $self->{attrs}{group_by};
   unless (defined $self->{count}) {
+    my $group_by;
+    my $select = { 'count' => '*' };
+    if( $group_by = delete $self->{attrs}{group_by} ) {
+      my @distinct = (ref $group_by ?  @$group_by : ($group_by));
+      # todo: try CONCAT for multi-column pk
+      my @pk = $self->result_source->primary_columns;
+      if( scalar(@pk) == 1 ) {
+        my $pk = shift(@pk);
+        my $alias = $self->{attrs}{alias};
+        my $re = qr/^($alias\.)?$pk$/;
+        foreach my $column ( @distinct) {
+          if( $column =~ $re ) {
+            @distinct = ( $column );
+            last;
+          }
+        } 
+      }
+
+      $select = { count => { 'distinct' => \@distinct } };
+      #use Data::Dumper; die Dumper $select;
+    }
+
     my $attrs = { %{ $self->{attrs} },
-                  select => { 'count' => '*' },
+                  select => $select,
                   as => [ 'count' ] };
     # offset, order by and page are not needed to count. record_filter is cdbi
     delete $attrs->{$_} for qw/rows offset order_by page pager record_filter/;
         
-    ($self->{count}) = (ref $self)->new($self->{source}, $attrs)->cursor->next;
+    ($self->{count}) = (ref $self)->new($self->result_source, $attrs)->cursor->next;
+    $self->{attrs}{group_by} = $group_by;
   }
   return 0 unless $self->{count};
   my $count = $self->{count};
@@ -436,9 +481,9 @@ Sets the specified columns in the resultset to the supplied values.
 
 sub update {
   my ($self, $values) = @_;
-  croak "Values for update must be a hash" unless ref $values eq 'HASH';
-  return $self->{source}->storage->update(
-           $self->{source}->from, $values, $self->{cond});
+  $self->throw_exception("Values for update must be a hash") unless ref $values eq 'HASH';
+  return $self->result_source->storage->update(
+           $self->result_source->from, $values, $self->{cond});
 }
 
 =head2 update_all(\%values)
@@ -450,7 +495,7 @@ will run cascade triggers while L</update> will not.
 
 sub update_all {
   my ($self, $values) = @_;
-  croak "Values for update must be a hash" unless ref $values eq 'HASH';
+  $self->throw_exception("Values for update must be a hash") unless ref $values eq 'HASH';
   foreach my $obj ($self->all) {
     $obj->set_columns($values)->update;
   }
@@ -465,7 +510,28 @@ Deletes the contents of the resultset from its result source.
 
 sub delete {
   my ($self) = @_;
-  $self->{source}->storage->delete($self->{source}->from, $self->{cond});
+  my $del = {};
+  $self->throw_exception("Can't delete on resultset with condition unless hash or array")
+    unless (ref($self->{cond}) eq 'HASH' || ref($self->{cond}) eq 'ARRAY');
+  if (ref $self->{cond} eq 'ARRAY') {
+    $del = [ map { my %hash;
+      foreach my $key (keys %{$_}) {
+        $key =~ /([^\.]+)$/;
+        $hash{$1} = $_->{$key};
+      }; \%hash; } @{$self->{cond}} ];
+  } elsif ((keys %{$self->{cond}})[0] eq '-and') {
+    $del->{-and} = [ map { my %hash;
+      foreach my $key (keys %{$_}) {
+        $key =~ /([^\.]+)$/;
+        $hash{$1} = $_->{$key};
+      }; \%hash; } @{$self->{cond}{-and}} ];
+  } else {
+    foreach my $key (keys %{$self->{cond}}) {
+      $key =~ /([^\.]+)$/;
+      $del->{$1} = $self->{cond}{$key};
+    }
+  }
+  $self->result_source->storage->delete($self->result_source->from, $del);
   return 1;
 }
 
@@ -492,7 +558,7 @@ sense for queries with a C<page> attribute.
 sub pager {
   my ($self) = @_;
   my $attrs = $self->{attrs};
-  croak "Can't create pager for non-paged rs" unless $self->{page};
+  $self->throw_exception("Can't create pager for non-paged rs") unless $self->{page};
   $attrs->{rows} ||= 10;
   $self->count;
   return $self->{pager} ||= Data::Page->new(
@@ -509,7 +575,7 @@ sub page {
   my ($self, $page) = @_;
   my $attrs = { %{$self->{attrs}} };
   $attrs->{page} = $page;
-  return (ref $self)->new($self->{source}, $attrs);
+  return (ref $self)->new($self->result_source, $attrs);
 }
 
 =head2 new_result(\%vals)
@@ -520,17 +586,17 @@ Creates a result in the resultset's result class.
 
 sub new_result {
   my ($self, $values) = @_;
-  $self->{source}->result_class->throw( "new_result needs a hash" )
+  $self->throw_exception( "new_result needs a hash" )
     unless (ref $values eq 'HASH');
-  $self->{source}->result_class->throw( "Can't abstract implicit construct, condition not a hash" )
+  $self->throw_exception( "Can't abstract implicit construct, condition not a hash" )
     if ($self->{cond} && !(ref $self->{cond} eq 'HASH'));
   my %new = %$values;
   my $alias = $self->{attrs}{alias};
   foreach my $key (keys %{$self->{cond}||{}}) {
     $new{$1} = $self->{cond}{$key} if ($key =~ m/^(?:$alias\.)?([^\.]+)$/);
   }
-  my $obj = $self->{source}->result_class->new(\%new);
-  $obj->result_source($self->{source}) if $obj->can('result_source');
+  my $obj = $self->result_source->result_class->new(\%new);
+  $obj->result_source($self->result_source) if $obj->can('result_source');
   $obj;
 }
 
@@ -544,7 +610,7 @@ Effectively a shortcut for C<< ->new_result(\%vals)->insert >>.
 
 sub create {
   my ($self, $attrs) = @_;
-  $self->{source}->result_class->throw( "create needs a hashref" ) unless ref $attrs eq 'HASH';
+  $self->throw_exception( "create needs a hashref" ) unless ref $attrs eq 'HASH';
   return $self->new_result($attrs)->insert;
 }
 
@@ -622,7 +688,7 @@ sub update_or_create {
   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
   my $hash  = ref $_[0] eq "HASH" ? shift : {@_};
 
-  my %unique_constraints = $self->{source}->unique_constraints;
+  my %unique_constraints = $self->result_source->unique_constraints;
   my @constraint_names   = (exists $attrs->{key}
                             ? ($attrs->{key})
                             : keys %unique_constraints);
@@ -655,6 +721,17 @@ sub update_or_create {
   return $row;
 }
 
+=head2 throw_exception
+
+See Schema's throw_exception
+
+=cut
+
+sub throw_exception {
+  my $self=shift;
+  $self->result_source->schema->throw_exception(@_);
+}
+
 =head1 ATTRIBUTES
 
 The resultset takes various attributes that modify its behavior. Here's an
@@ -671,6 +748,14 @@ Shortcut to request a particular set of columns to be retrieved.  Adds
 C<me.> onto the start of any column without a C<.> in it and sets C<select>
 from that, then auto-populates C<as> from C<select> as normal.
 
+=head2 include_columns (arrayref)
+
+Shortcut to include additional columns in the returned results - for example
+
+  { include_columns => ['foo.name'], join => ['foo'] }
+
+would add a 'name' column to the information passed to object inflation
+
 =head2 select (arrayref)
 
 Indicates which columns should be selected from the storage. You can use
@@ -756,7 +841,18 @@ For example:
     }
   );
 
-If you want to fetch columns from related tables as well, see C<prefetch>
+If the same join is supplied twice, it will be aliased to <rel>_2 (and
+similarly for a third time). For e.g.
+
+  my $rs = $schema->resultset('Artist')->search(
+    { 'cds.title'   => 'Foo',
+      'cds_2.title' => 'Bar' },
+    { join => [ qw/cds cds/ ] });
+
+will return a set of all artists that have both a cd with title Foo and a cd
+with title Bar.
+
+If you want to fetch related objects from other tables as well, see C<prefetch>
 below.
 
 =head2 prefetch arrayref/hashref
@@ -785,11 +881,14 @@ L<DBIx::Class> has no need to go back to the database when we access the
 C<cd> or C<artist> relationships, which saves us two SQL statements in this
 case.
 
-Any prefetched relationship will be joined automatically, so there is no need
-for a C<join> attribute in the above search.
+Simple prefetches will be joined automatically, so there is no need
+for a C<join> attribute in the above search. If you're prefetching to
+depth (e.g. { cd => { artist => 'label' } or similar), you'll need to
+specify the join as well.
 
 C<prefetch> can be used with the following relationship types: C<belongs_to>,
-C<has_one>.
+C<has_one> (or if you're using C<add_relationship>, any relationship declared
+with an accessor type of 'single' or 'filter').
 
 =head2 from (arrayref)
 
@@ -893,8 +992,7 @@ Can also be used to simulate an SQL C<LIMIT>.
 
 =head2 group_by (arrayref)
 
-A arrayref of columns to group by. Can include columns of joined tables. Note
-note that L</count> doesn't work on grouped resultsets.
+A arrayref of columns to group by. Can include columns of joined tables.
 
   group_by => [qw/ column1 column2 ... /]