a few more fixups to ExampleSchema.pod
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / ResultSet.pm
index 4546c1f..f1ca440 100644 (file)
@@ -2,14 +2,17 @@ package DBIx::Class::ResultSet;
 
 use strict;
 use warnings;
-use Carp qw/croak/;
 use overload
-        '0+'     => 'count',
+        '0+'     => \&count,
         'bool'   => sub { 1; },
         fallback => 1;
 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.
@@ -29,6 +32,7 @@ In the examples below, the following table classes are used:
 
   package MyApp::Schema::Artist;
   use base qw/DBIx::Class/;
+  __PACKAGE__->load_components(qw/Core/);
   __PACKAGE__->table('artist');
   __PACKAGE__->add_columns(qw/artistid name/);
   __PACKAGE__->set_primary_key('artistid');
@@ -37,7 +41,8 @@ In the examples below, the following table classes are used:
 
   package MyApp::Schema::CD;
   use base qw/DBIx::Class/;
-  __PACKAGE__->table('artist');
+  __PACKAGE__->load_components(qw/Core/);
+  __PACKAGE__->table('cd');
   __PACKAGE__->add_columns(qw/cdid artist title year/);
   __PACKAGE__->set_primary_key('cdid');
   __PACKAGE__->belongs_to(artist => 'MyApp::Schema::Artist');
@@ -45,10 +50,12 @@ In the examples below, the following table classes are used:
 
 =head1 METHODS
 
-=head2 new($source, \%$attrs)
+=head2 new
+
+=head3 Arguments: ($source, \%$attrs)
 
 The resultset constructor. Takes a source object (usually a
-L<DBIx::Class::ResultSourceProxy::Table>) and an attribute hash (see L</ATRRIBUTES>
+L<DBIx::Class::ResultSourceProxy::Table>) and an attribute hash (see L</ATTRIBUTES>
 below).  Does not perform any queries -- these are executed as needed by the
 other methods.
 
@@ -75,8 +82,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 +98,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 +115,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 +128,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 +172,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);
 }
@@ -175,7 +186,7 @@ Pass a literal chunk of SQL to be added to the conditional part of the
 resultset.
 
 =cut
-                                                         
+
 sub search_literal {
   my ($self, $cond, @vals) = @_;
   my $attrs = (ref $vals[$#vals] eq 'HASH' ? { %{ pop(@vals) } } : {});
@@ -183,7 +194,9 @@ sub search_literal {
   return $self->search(\$cond, $attrs);
 }
 
-=head2 find(@colvalues), find(\%cols, \%attrs?)
+=head2 find
+
+=head3 Arguments: (@colvalues) | (\%cols, \%attrs?)
 
 Finds a row based on its primary key or unique constraint. For example:
 
@@ -192,7 +205,7 @@ Finds a row based on its primary key or unique constraint. For example:
 Also takes an optional C<key> attribute, to search by a specific key or unique
 constraint. For example:
 
-  my $cd = $schema->resultset('CD')->find_or_create(
+  my $cd = $schema->resultset('CD')->find(
     {
       artist => 'Massive Attack',
       title  => 'Mezzanine',
@@ -208,32 +221,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 +260,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 +285,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);
 }
 
@@ -297,7 +313,9 @@ sub search_like {
   return $class->search($query, { %$attrs });
 }
 
-=head2 slice($first, $last)
+=head2 slice
+
+=head3 Arguments: ($first, $last)
 
 Returns a subset of elements from the resultset.
 
@@ -309,7 +327,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 +367,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};
@@ -428,7 +481,9 @@ sub first {
   return $_[0]->reset->next;
 }
 
-=head2 update(\%values)
+=head2 update
+
+=head3 Arguments: (\%values)
 
 Sets the specified columns in the resultset to the supplied values.
 
@@ -436,12 +491,14 @@ 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)
+=head2 update_all
+
+=head3 Arguments: (\%values)
 
 Fetches all objects and updates them one at a time.  Note that C<update_all>
 will run cascade triggers while L</update> will not.
@@ -450,7 +507,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 +522,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,14 +570,16 @@ 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(
     $self->{count}, $attrs->{rows}, $self->{page});
 }
 
-=head2 page($page_num)
+=head2 page
+
+=head3 Arguments: ($page_num)
 
 Returns a new resultset for the specified page.
 
@@ -509,10 +589,12 @@ 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)
+=head2 new_result
+
+=head3 Arguments: (\%vals)
 
 Creates a result in the resultset's result class.
 
@@ -520,21 +602,23 @@ 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;
 }
 
-=head2 create(\%vals)
+=head2 create
+
+=head3 Arguments: (\%vals)
 
 Inserts a record into the resultset and returns the object.
 
@@ -544,16 +628,18 @@ 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;
 }
 
-=head2 find_or_create(\%vals, \%attrs?)
+=head2 find_or_create
+
+=head3 Arguments: (\%vals, \%attrs?)
 
   $class->find_or_create({ key => $val, ... });
 
-Searches for a record matching the search condition; if it doesn't find one,    
-creates one and returns that instead.                                       
+Searches for a record matching the search condition; if it doesn't find one,
+creates one and returns that instead.
 
   my $cd = $schema->resultset('CD')->find_or_create({
     cdid   => 5,
@@ -622,7 +708,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 +741,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
@@ -665,13 +762,27 @@ overview of them:
 Which column(s) to order the results by. This is currently passed through
 directly to SQL, so you can give e.g. C<foo DESC> for a descending order.
 
-=head2 cols (arrayref)
+=head2 cols
+
+=head3 Arguments: (arrayref)
 
 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 select (arrayref)
+=head2 include_columns
+
+=head3 Arguments: (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
+
+=head3 Arguments: (arrayref)
 
 Indicates which columns should be selected from the storage. You can use
 column names, or in the case of RDBMS back ends, function or stored procedure
@@ -692,7 +803,9 @@ When you use function/stored procedure names and do not supply an C<as>
 attribute, the column names returned are storage-dependent. E.g. MySQL would
 return a column named C<count(column_to_count)> in the above example.
 
-=head2 as (arrayref)
+=head2 as
+
+=head3 Arguments: (arrayref)
 
 Indicates column names for object inflation. This is used in conjunction with
 C<select>, usually when C<select> contains one or more function or stored
@@ -756,10 +869,23 @@ 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
+=head2 prefetch
+
+=head3 Arguments: arrayref/hashref
 
 Contains one or more relationships that should be fetched along with the main 
 query (when they are accessed afterwards they will have already been
@@ -785,13 +911,18 @@ 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
 
-=head2 from (arrayref)
+=head3 Arguments: (arrayref)
 
 The C<from> attribute gives you manual control over the C<FROM> clause of SQL
 statements generated by L<DBIx::Class>, allowing you to express custom C<JOIN>
@@ -843,7 +974,7 @@ then search against all mothers of those children:
                       ]
                   ],
                   { 'mother.person_id' => 'child.mother_id' }
-              ],                
+              ],
           ]
       },
   );
@@ -891,10 +1022,11 @@ For a paged resultset, how many rows per page:
 
 Can also be used to simulate an SQL C<LIMIT>.
 
-=head2 group_by (arrayref)
+=head2 group_by
+
+=head3 Arguments: (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 ... /]