Merge 'find_compat' into 'DBIx-Class-current'
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / ResultSet.pm
index f57c913..ec41bc5 100644 (file)
@@ -6,6 +6,7 @@ use overload
         '0+'     => \&count,
         'bool'   => sub { 1; },
         fallback => 1;
+use Carp::Clan qw/^DBIx::Class/;
 use Data::Page;
 use Storable;
 use Data::Dumper;
@@ -262,7 +263,7 @@ a row by its primary key:
 You can also find a row by a specific unique constraint using the C<key>
 attribute. For example:
 
-  my $cd = $schema->resultset('CD')->find('Massive Attack', 'Mezzanine', { key => 'artist_title' });
+  my $cd = $schema->resultset('CD')->find('Massive Attack', 'Mezzanine', { key => 'cd_artist_title' });
 
 Additionally, you can specify the columns explicitly by name:
 
@@ -271,14 +272,14 @@ Additionally, you can specify the columns explicitly by name:
       artist => 'Massive Attack',
       title  => 'Mezzanine',
     },
-    { key => 'artist_title' }
+    { key => 'cd_artist_title' }
   );
 
-If no C<key> is specified and you explicitly name columns, it searches on all
-unique constraints defined on the source, including the primary key.
-
 If the C<key> is specified as C<primary>, it searches only on the primary key.
 
+If no C<key> is specified, it searches on all unique constraints defined on the
+source, including the primary key.
+
 See also L</find_or_create> and L</update_or_create>. For information on how to
 declare unique constraints, see
 L<DBIx::Class::ResultSource/add_unique_constraint>.
@@ -289,66 +290,77 @@ sub find {
   my $self = shift;
   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
 
-  # Parse out a hash from input
+  # Default to the primary key, but allow a specific key
   my @cols = exists $attrs->{key}
     ? $self->result_source->unique_constraint_columns($attrs->{key})
     : $self->result_source->primary_columns;
+  $self->throw_exception(
+    "Can't find unless a primary key or unique constraint is defined"
+  ) unless @cols;
 
-  my $hash;
+  # Parse out a hashref from input
+  my $input_query;
   if (ref $_[0] eq 'HASH') {
-    $hash = { %{$_[0]} };
+    $input_query = { %{$_[0]} };
   }
   elsif (@_ == @cols) {
-    $hash = {};
-    @{$hash}{@cols} = @_;
+    $input_query = {};
+    @{$input_query}{@cols} = @_;
   }
-  elsif (@_) {
-    # For backwards compatibility
-    $hash = {@_};
+  else {
+    # Compatibility: Allow e.g. find(id => $value)
+    carp "Find by key => value deprecated; please use a hashref instead";
+    $input_query = {@_};
+  }
+
+  my @unique_queries = $self->_unique_queries($input_query, $attrs);
+#  use Data::Dumper; warn Dumper $self->result_source->name, $input_query, \@unique_queries, $self->{attrs}->{where};
+
+  # Handle cases where the ResultSet defines the query, or where the user is
+  # abusing find
+  my $query = @unique_queries ? \@unique_queries : $input_query;
+
+  # Run the query
+  if (keys %$attrs) {
+    my $rs = $self->search($query, $attrs);
+    $rs->_resolve;
+    return keys %{$rs->{_attrs}->{collapse}} ? $rs->next : $rs->single;
   }
   else {
-    $self->throw_exception(
-      "Arguments to find must be a hashref or match the number of columns in the "
-        . (exists $attrs->{key} ? "$attrs->{key} unique constraint" : "primary key")
-    );
+    $self->_resolve;  
+    return (keys %{$self->{_attrs}->{collapse}})
+      ? $self->search($query)->next
+      : $self->single($query);
   }
+}
+
+# _unique_queries
+#
+# Build a list of queries which satisfy unique constraints.
+
+sub _unique_queries {
+  my ($self, $query, $attrs) = @_;
 
-  # Check the hash we just parsed against our source's unique constraints
   my @constraint_names = exists $attrs->{key}
     ? ($attrs->{key})
     : $self->result_source->unique_constraint_names;
-  $self->throw_exception(
-    "Can't find unless a primary key or unique constraint is defined"
-  ) unless @constraint_names;
 
   my @unique_queries;
   foreach my $name (@constraint_names) {
     my @unique_cols = $self->result_source->unique_constraint_columns($name);
-    my $unique_query = $self->_build_unique_query($hash, \@unique_cols);
+    my $unique_query = $self->_build_unique_query($query, \@unique_cols);
+
+    next unless scalar keys %$unique_query;
 
     # Add the ResultSet's alias
     foreach my $key (grep { ! m/\./ } keys %$unique_query) {
-      $unique_query->{"$self->{attrs}{alias}.$key"} = delete $unique_query->{$key};
+      $unique_query->{"$self->{attrs}->{alias}.$key"} = delete $unique_query->{$key};
     }
 
-    push @unique_queries, $unique_query if %$unique_query;
+    push @unique_queries, $unique_query;
   }
 
-  # Handle cases where the ResultSet already defines the query
-  my $query = @unique_queries ? \@unique_queries : undef;
-
-  # Run the query
-  if (keys %$attrs) {
-    my $rs = $self->search($query, $attrs);
-    $rs->_resolve;
-    return keys %{$rs->{_attrs}->{collapse}} ? $rs->next : $rs->single;
-  }
-  else {
-    $self->_resolve;  
-    return (keys %{$self->{_attrs}->{collapse}})
-      ? $self->search($query)->next
-      : $self->single($query);
-  }
+  return @unique_queries;
 }
 
 # _build_unique_query
@@ -451,12 +463,84 @@ sub single {
     }
   }
 
+  unless ($self->_is_unique_query($attrs->{where})) {
+    carp "Query not guarnteed to return a single row"
+      . "; please declare your unique constraints or use search instead";
+  }
+
   my @data = $self->result_source->storage->select_single(
           $attrs->{from}, $attrs->{select},
           $attrs->{where},$attrs);
   return (@data ? $self->_construct_object(@data) : ());
 }
 
+# _is_unique_query
+#
+# Try to determine if the specified query is guaranteed to be unique, based on
+# the declared unique constraints.
+
+sub _is_unique_query {
+  my ($self, $query) = @_;
+
+  my $collapsed = $self->_collapse_query($query);
+#  use Data::Dumper; warn Dumper $query, $collapsed;
+
+  foreach my $name ($self->result_source->unique_constraint_names) {
+    my @unique_cols = map { "$self->{attrs}->{alias}.$_" }
+      $self->result_source->unique_constraint_columns($name);
+
+    # Count the values for each unique column
+    my %seen = map { $_ => 0 } @unique_cols;
+
+    foreach my $key (keys %$collapsed) {
+      my $aliased = $key;
+      $aliased = "$self->{attrs}->{alias}.$key" unless $key =~ /\./;
+
+      next unless exists $seen{$aliased};  # Additional constraints are okay
+      $seen{$aliased} = scalar @{ $collapsed->{$key} };
+    }
+
+    # If we get 0 or more than 1 value for a column, it's not necessarily unique
+    return 1 unless grep { $_ != 1 } values %seen;
+  }
+
+  return 0;
+}
+
+# _collapse_query
+#
+# Recursively collapse the query, accumulating values for each column.
+
+sub _collapse_query {
+  my ($self, $query, $collapsed) = @_;
+
+  $collapsed ||= {};
+
+  if (ref $query eq 'ARRAY') {
+    foreach my $subquery (@$query) {
+      next unless ref $subquery;  # -or
+#      warn "ARRAY: " . Dumper $subquery;
+      $collapsed = $self->_collapse_query($subquery, $collapsed);
+    }
+  }
+  elsif (ref $query eq 'HASH') {
+    if (keys %$query and (keys %$query)[0] eq '-and') {
+      foreach my $subquery (@{$query->{-and}}) {
+#        warn "HASH: " . Dumper $subquery;
+        $collapsed = $self->_collapse_query($subquery, $collapsed);
+      }
+    }
+    else {
+#      warn "LEAF: " . Dumper $query;
+      foreach my $key (keys %$query) {
+        push @{$collapsed->{$key}}, $query->{$key};
+      }
+    }
+  }
+
+  return $collapsed;
+}
+
 =head2 get_column
 
 =over 4
@@ -630,6 +714,18 @@ sub _resolve {
   $attrs->{order_by} = [ $attrs->{order_by} ] if
       $attrs->{order_by} and !ref($attrs->{order_by});
   $attrs->{order_by} ||= [];
+
+ if(my $seladds = delete($attrs->{'+select'})) {
+   my @seladds = (ref($seladds) eq 'ARRAY' ? @$seladds : ($seladds));
+   $attrs->{select} = [
+     @{ $attrs->{select} },
+     map { (m/\./ || ref($_)) ? $_ : "${alias}.$_" } $seladds
+   ];
+ }
+ if(my $asadds = delete($attrs->{'+as'})) {
+   my @asadds = (ref($asadds) eq 'ARRAY' ? @$asadds : ($asadds));
+   $attrs->{as} = [ @{ $attrs->{as} }, @asadds ];
+ }
   
   my $collapse = $attrs->{collapse} || {};
   if (my $prefetch = delete $attrs->{prefetch}) {
@@ -847,7 +943,7 @@ sub _count { # Separated out so pager can get the full count
   
   $self->_resolve;
   my $attrs = { %{ $self->{_attrs} } };
-  if ($attrs->{distinct} && (my $group_by = $attrs->{group_by} || $attrs->{select})) {
+  if (my $group_by = delete $attrs->{group_by}) {
     delete $attrs->{having};
     my @distinct = (ref $group_by ?  @$group_by : ($group_by));
     # todo: try CONCAT for multi-column pk
@@ -1281,8 +1377,8 @@ sub create {
 
   $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.
+Tries to find a record based on its primary key or unique constraint; if none
+is found, creates one and returns that instead.
 
   my $cd = $schema->resultset('CD')->find_or_create({
     cdid   => 5,
@@ -1299,7 +1395,7 @@ constraint. For example:
       artist => 'Massive Attack',
       title  => 'Mezzanine',
     },
-    { key => 'artist_title' }
+    { key => 'cd_artist_title' }
   );
 
 See also L</find> and L</update_or_create>. For information on how to declare
@@ -1342,7 +1438,7 @@ For example:
       title  => 'Mezzanine',
       year   => 1998,
     },
-    { key => 'artist_title' }
+    { key => 'cd_artist_title' }
   );
 
 If no C<key> is specified, it searches on all unique constraints defined on the
@@ -1358,15 +1454,15 @@ unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
 sub update_or_create {
   my $self = shift;
   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
-  my $hash = ref $_[0] eq 'HASH' ? shift : {@_};
+  my $cond = ref $_[0] eq 'HASH' ? shift : {@_};
 
-  my $row = $self->find($hash, $attrs);
+  my $row = $self->find($cond);
   if (defined $row) {
-    $row->update($hash);
+    $row->update($cond);
     return $row;
   }
 
-  return $self->create($hash);
+  return $self->create($cond);
 }
 
 =head2 get_cache
@@ -1502,6 +1598,11 @@ Which column(s) to order the results by. This is currently passed
 through directly to SQL, so you can give e.g. C<year DESC> for a
 descending order on the column `year'.
 
+Please note that if you have quoting enabled (see 
+L<DBIx::Class::Storage/quote_char>) you will need to do C<\'year DESC' > to
+specify an order. (The scalar ref causes it to be passed as raw sql to the DB,
+so you will need to manually quote things as appropriate.)
+
 =head2 columns
 
 =over 4
@@ -1557,6 +1658,23 @@ 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(employeeid)> in the above example.
 
+=head2 +select
+
+=over 4
+
+Indicates additional columns to be selected from storage.  Works the same as
+L<select> but adds columns to the selection.
+
+=back
+
+=head2 +as
+
+=over 4
+
+Indicates additional column names for those added via L<+select>.
+
+=back
+
 =head2 as
 
 =over 4
@@ -1701,7 +1819,9 @@ with an accessor type of 'single' or 'filter').
 
 Makes the resultset paged and specifies the page to retrieve. Effectively
 identical to creating a non-pages resultset and then calling ->page($page)
-on it.
+on it. 
+
+If L<rows> attribute is not specified it defualts to 10 rows per page.
 
 =head2 rows
 
@@ -1714,6 +1834,17 @@ on it.
 Specifes the maximum number of rows for direct retrieval or the number of
 rows per page if the page attribute or method is used.
 
+=head2 offset
+
+=over 4
+
+=item Value: $offset
+
+=back
+
+Specifies the (zero-based) row number for the  first row to be returned, or the
+of the first row of the first page if paging is used.
+
 =head2 group_by
 
 =over 4