Merge branch 'people/riba/find_cleanup' into people/riba/master_cherry
Peter Rabbitson [Sun, 17 Oct 2010 15:47:27 +0000 (17:47 +0200)]
Changes
lib/DBIx/Class/ResultSet.pm
t/60core.t
t/61findnot.t
t/72pg.t
t/80unique.t
t/bind/bindtype_columns.t
t/lib/DBICTest/Schema/Artist.pm
t/lib/sqlite.sql
t/relationship/update_or_create_multi.t

diff --git a/Changes b/Changes
index 6ddd10a..c1291c7 100644 (file)
--- a/Changes
+++ b/Changes
@@ -22,6 +22,10 @@ Revision history for DBIx::Class
           at instantiation time
         - New documentation map organized by features
           (DBIx::Class::Manual::Features)
+        - find( { ... }, { key => $constraint } ) now throws an exception
+          when the supplied data does not fully specify $constraint
+        - find( col1 => $val1, col2 => $val2, ... ) is no longer supported
+          (it has been in deprecated state for more than 4 years)
 
     * Fixes
         - Fix memory leak during populate() on 5.8.x perls
@@ -29,6 +33,8 @@ Revision history for DBIx::Class
         - Make sure exception_action does not allow exception-hiding
           due to badly-written handlers (the mechanism was never meant
           to be able to suppress exceptions)
+        - Fix find() without a key attr. choosing constraints even if
+          some of the supplied values are NULL (RT#59219)
         - Fixed rels ending with me breaking subqueried limit realiasing
         - Fixed $rs->update/delete on resutsets constrained by an
           -or condition
index 6c4c976..aabae51 100644 (file)
@@ -272,106 +272,96 @@ sub search_rs {
 
   # Special-case handling for (undef, undef).
   if ( @_ == 2 && !defined $_[1] && !defined $_[0] ) {
-    pop(@_); pop(@_);
+    @_ = ();
   }
 
-  my $attrs = {};
-  $attrs = pop(@_) if @_ > 1 and ref $_[$#_] eq 'HASH';
-  my $our_attrs = { %{$self->{attrs}} };
-  my $having = delete $our_attrs->{having};
-  my $where = delete $our_attrs->{where};
-
-  my $rows;
+  my $call_attrs = {};
+  $call_attrs = pop(@_) if @_ > 1 and ref $_[-1] eq 'HASH';
 
+  # see if we can keep the cache (no $rs changes)
+  my $cache;
   my %safe = (alias => 1, cache => 1);
-
-  unless (
-    (@_ && defined($_[0])) # @_ == () or (undef)
-    ||
-    (keys %$attrs # empty attrs or only 'safe' attrs
-    && List::Util::first { !$safe{$_} } keys %$attrs)
-  ) {
-    # no search, effectively just a clone
-    $rows = $self->get_cache;
+  if ( ! List::Util::first { !$safe{$_} } keys %$call_attrs and (
+    ! defined $_[0]
+      or
+    ref $_[0] eq 'HASH' && ! keys %{$_[0]}
+      or
+    ref $_[0] eq 'ARRAY' && ! @{$_[0]}
+  )) {
+    $cache = $self->get_cache;
   }
 
+  my $old_attrs = { %{$self->{attrs}} };
+  my $old_having = delete $old_attrs->{having};
+  my $old_where = delete $old_attrs->{where};
+
   # reset the selector list
-  if (List::Util::first { exists $attrs->{$_} } qw{columns select as}) {
-     delete @{$our_attrs}{qw{select as columns +select +as +columns include_columns}};
+  if (List::Util::first { exists $call_attrs->{$_} } qw{columns select as}) {
+     delete @{$old_attrs}{qw{select as columns +select +as +columns include_columns}};
   }
 
-  my $new_attrs = { %{$our_attrs}, %{$attrs} };
+  my $new_attrs = { %{$old_attrs}, %{$call_attrs} };
 
   # merge new attrs into inherited
   foreach my $key (qw/join prefetch +select +as +columns include_columns bind/) {
-    next unless exists $attrs->{$key};
-    $new_attrs->{$key} = $self->_merge_attr($our_attrs->{$key}, $attrs->{$key});
+    next unless exists $call_attrs->{$key};
+    $new_attrs->{$key} = $self->_merge_attr($old_attrs->{$key}, $call_attrs->{$key});
   }
 
-  my $cond = (@_
-    ? (
-        (@_ == 1 || ref $_[0] eq "HASH")
-          ? (
-              (ref $_[0] eq 'HASH')
-                ? (
-                    (keys %{ $_[0] }  > 0)
-                      ? shift
-                      : undef
-                   )
-                :  shift
-             )
-          : (
-              (@_ % 2)
-                ? $self->throw_exception("Odd number of arguments to search")
-                : {@_}
-             )
-      )
-    : undef
-  );
+  # rip apart the rest of @_, parse a condition
+  my $call_cond = do {
 
-  if (defined $where) {
-    $new_attrs->{where} = (
-      defined $new_attrs->{where}
-        ? { '-and' => [
-              map {
-                ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_
-              } $where, $new_attrs->{where}
-            ]
-          }
-        : $where);
-  }
+    if (ref $_[0] eq 'HASH') {
+      (keys %{$_[0]}) ? $_[0] : undef
+    }
+    elsif (@_ == 1) {
+      $_[0]
+    }
+    elsif (@_ % 2) {
+      $self->throw_exception('Odd number of arguments to search')
+    }
+    else {
+      +{ @_ }
+    }
 
-  if (defined $cond) {
-    $new_attrs->{where} = (
-      defined $new_attrs->{where}
-        ? { '-and' => [
-              map {
-                ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_
-              } $cond, $new_attrs->{where}
-            ]
-          }
-        : $cond);
+  } if @_;
+
+  for ($old_where, $call_cond) {
+    if (defined $_) {
+      $new_attrs->{where} = $self->_stack_cond (
+        $_, $new_attrs->{where}
+      );
+    }
   }
 
-  if (defined $having) {
-    $new_attrs->{having} = (
-      defined $new_attrs->{having}
-        ? { '-and' => [
-              map {
-                ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_
-              } $having, $new_attrs->{having}
-            ]
-          }
-        : $having);
+  if (defined $old_having) {
+    $new_attrs->{having} = $self->_stack_cond (
+      $old_having, $new_attrs->{having}
+    )
   }
 
   my $rs = (ref $self)->new($self->result_source, $new_attrs);
 
-  $rs->set_cache($rows) if ($rows);
+  $rs->set_cache($cache) if ($cache);
 
   return $rs;
 }
 
+sub _stack_cond {
+  my ($self, $left, $right) = @_;
+  if (defined $left xor defined $right) {
+    return defined $left ? $left : $right;
+  }
+  elsif (defined $left) {
+    return { -and => [ map
+      { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
+      ($left, $right)
+    ]};
+  }
+
+  return undef;
+}
+
 =head2 search_literal
 
 =over 4
@@ -418,25 +408,56 @@ sub search_literal {
 
 =over 4
 
-=item Arguments: @values | \%cols, \%attrs?
+=item Arguments: \%columns_values | @pk_values, \%attrs?
 
 =item Return Value: $row_object | undef
 
 =back
 
-Finds a row based on its primary key or unique constraint. For example, to find
-a row by its primary key:
+Finds and returns a single row based on supplied criteria. Takes either a
+hashref with the same format as L</create> (including inference of foreign
+keys from related objects), or a list of primary key values in the same
+order as the L<primary columns|DBIx::Class::ResultSource/primary_columns>
+declaration on the L</result_source>.
+
+In either case an attempt is made to combine conditions already existing on
+the resultset with the condition passed to this method.
+
+To aid with preparing the correct query for the storage you may supply the
+C<key> attribute, which is the name of a
+L<unique constraint|DBIx::Class::ResultSource/add_unique_constraint> (the
+unique constraint corresponding to the
+L<primary columns|DBIx::Class::ResultSource/primary_columns> is always named
+C<primary>). If the C<key> attribute has been supplied, and DBIC is unable
+to construct a query that satisfies the named unique constraint fully (
+non-NULL values for each column member of the constraint) an exception is
+thrown.
+
+If no C<key> is specified, the search is carried over all unique constraints
+which are fully defined by the available condition.
+
+If no such constraint is found, C<find> currently defaults to a simple
+C<< search->(\%column_values) >> which may or may not do what you expect.
+Note that this fallback behavior may be deprecated in further versions. If
+you need to search with arbitrary conditions - use L</search>.
 
-  my $cd = $schema->resultset('CD')->find(5);
+In addition to C<key>, L</find> recognizes and applies standard
+L<resultset attributes|/ATTRIBUTES> in the same way as L</search> does.
 
-You can also find a row by a specific unique constraint using the C<key>
-attribute. For example:
+If the resulting query produces more than one row, a warning to the effect is
+issued, though only the first row is constructed and returned as C<$row_object>
 
-  my $cd = $schema->resultset('CD')->find('Massive Attack', 'Mezzanine', {
-    key => 'cd_artist_title'
-  });
+Note that if you have extra concerns about the correctness of the resulting
+query you need to specify the C<key> attribute and supply the entire condition
+as an argument to find (since it is not always possible to perform the
+combination of the resultset condition with the supplied one, especially if
+the resultset condition contains literal sql).
+
+For example, to find a row by its primary key:
+
+  my $cd = $schema->resultset('CD')->find(5);
 
-Additionally, you can specify the columns explicitly by name:
+You can also find a row by a specific unique constraint:
 
   my $cd = $schema->resultset('CD')->find(
     {
@@ -446,24 +467,7 @@ Additionally, you can specify the columns explicitly by name:
     { key => 'cd_artist_title' }
   );
 
-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 for which column data is provided, including the primary key.
-
-If your table does not have a primary key, you B<must> provide a value for the
-C<key> attribute matching one of the unique constraints on the source.
-
-In addition to C<key>, L</find> recognizes and applies standard
-L<resultset attributes|/ATTRIBUTES> in the same way as L</search> does.
-
-Note: If your query does not return only one row, a warning is generated:
-
-  Query returned more than one row
-
-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>.
+See also L</find_or_create> and L</update_or_create>.
 
 =cut
 
@@ -471,57 +475,64 @@ sub find {
   my $self = shift;
   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
 
-  # 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 is defined or unique constraint is specified"
-  ) unless @cols;
+  my $rsrc = $self->result_source;
 
-  # Parse out a hashref from input
-  my $input_query;
+  # Parse out the condition from input
+  my $call_cond;
   if (ref $_[0] eq 'HASH') {
-    $input_query = { %{$_[0]} };
-  }
-  elsif (@_ == @cols) {
-    $input_query = {};
-    @{$input_query}{@cols} = @_;
+    $call_cond = { %{$_[0]} };
   }
   else {
-    # Compatibility: Allow e.g. find(id => $value)
-    carp "Find by key => value deprecated; please use a hashref instead";
-    $input_query = {@_};
-  }
-
-  my (%related, $info);
-
-  KEY: foreach my $key (keys %$input_query) {
-    if (ref($input_query->{$key})
-        && ($info = $self->result_source->relationship_info($key))) {
-      my $val = delete $input_query->{$key};
-      next KEY if (ref($val) eq 'ARRAY'); # has_many for multi_create
-      my $rel_q = $self->result_source->_resolve_condition(
-                    $info->{cond}, $val, $key
-                  );
-      die "Can't handle OR join condition in find" if ref($rel_q) eq 'ARRAY';
+    my $constraint = exists $attrs->{key} ? $attrs->{key} : 'primary';
+    my @c_cols = $rsrc->unique_constraint_columns($constraint);
+
+    $self->throw_exception(
+      "No constraint columns, maybe a malformed '$constraint' constraint?"
+    ) unless @c_cols;
+
+    $self->throw_exception (
+      'find() expects either a column/value hashref, or a list of values '
+    . "corresponding to the columns of the specified unique constraint '$constraint'"
+    ) unless @c_cols == @_;
+
+    $call_cond = {};
+    @{$call_cond}{@c_cols} = @_;
+  }
+
+  my %related;
+  for my $key (keys %$call_cond) {
+    if (
+      my $keyref = ref($call_cond->{$key})
+        and
+      my $relinfo = $rsrc->relationship_info($key)
+    ) {
+      my $val = delete $call_cond->{$key};
+
+      next if $keyref eq 'ARRAY'; # has_many for multi_create
+
+      my $rel_q = $rsrc->_resolve_condition(
+        $relinfo->{cond}, $val, $key
+      );
+      die "Can't handle complex relationship conditions in find" if ref($rel_q) ne 'HASH';
       @related{keys %$rel_q} = values %$rel_q;
     }
   }
-  if (my @keys = keys %related) {
-    @{$input_query}{@keys} = values %related;
-  }
 
+  # relationship conditions take precedence (?)
+  @{$call_cond}{keys %related} = values %related;
 
-  # Build the final query: Default to the disjunction of the unique queries,
-  # but allow the input query in case the ResultSet defines the query or the
-  # user is abusing find
   my $alias = exists $attrs->{alias} ? $attrs->{alias} : $self->{attrs}{alias};
-  my $query;
+  my $final_cond;
   if (exists $attrs->{key}) {
-    my @unique_cols = $self->result_source->unique_constraint_columns($attrs->{key});
-    my $unique_query = $self->_build_unique_query($input_query, \@unique_cols);
-    $query = $self->_add_alias($unique_query, $alias);
+    $final_cond = $self->_qualify_cond_columns (
+
+      $self->_build_unique_cond (
+        $attrs->{key},
+        $call_cond,
+      ),
+
+      $alias,
+    );
   }
   elsif ($self->{attrs}{accessor} and $self->{attrs}{accessor} eq 'single') {
     # This means that we got here after a merger of relationship conditions
@@ -532,14 +543,28 @@ sub find {
     # relationship
   }
   else {
-    my @unique_queries = $self->_unique_queries($input_query, $attrs);
-    $query = @unique_queries
-      ? [ map { $self->_add_alias($_, $alias) } @unique_queries ]
-      : $self->_add_alias($input_query, $alias);
+    # no key was specified - fall down to heuristics mode:
+    # run through all unique queries registered on the resultset, and
+    # 'OR' all qualifying queries together
+    my (@unique_queries, %seen_column_combinations);
+    for my $c_name ($rsrc->unique_constraint_names) {
+      next if $seen_column_combinations{
+        join "\x00", sort $rsrc->unique_constraint_columns($c_name)
+      }++;
+
+      push @unique_queries, try {
+        $self->_build_unique_cond ($c_name, $call_cond)
+      } || ();
+    }
+
+    $final_cond = @unique_queries
+      ? [ map { $self->_qualify_cond_columns($_, $alias) } @unique_queries ]
+      : $self->_qualify_cond_columns($call_cond, $alias)
+    ;
   }
 
   # Run the query, passing the result_class since it should propagate for find
-  my $rs = $self->search ($query, {result_class => $self->result_class, %$attrs});
+  my $rs = $self->search ($final_cond, {result_class => $self->result_class, %$attrs});
   if (keys %{$rs->_resolved_attrs->{collapse}}) {
     my $row = $rs->next;
     carp "Query returned more than one row" if $rs->next;
@@ -550,71 +575,41 @@ sub find {
   }
 }
 
-# _add_alias
-#
-# Add the specified alias to the specified query hash. A copy is made so the
-# original query is not modified.
-
-sub _add_alias {
-  my ($self, $query, $alias) = @_;
+sub _qualify_cond_columns {
+  my ($self, $cond, $alias) = @_;
 
-  my %aliased = %$query;
-  foreach my $col (grep { ! m/\./ } keys %aliased) {
-    $aliased{"$alias.$col"} = delete $aliased{$col};
+  my %aliased = %$cond;
+  for (keys %aliased) {
+    $aliased{"$alias.$_"} = delete $aliased{$_}
+      if $_ !~ /\./;
   }
 
   return \%aliased;
 }
 
-# _unique_queries
-#
-# Build a list of queries which satisfy unique constraints.
-
-sub _unique_queries {
-  my ($self, $query, $attrs) = @_;
-
-  my @constraint_names = exists $attrs->{key}
-    ? ($attrs->{key})
-    : $self->result_source->unique_constraint_names;
+sub _build_unique_cond {
+  my ($self, $constraint_name, $extra_cond) = @_;
 
-  my $where = $self->_collapse_cond($self->{attrs}{where} || {});
-  my $num_where = scalar keys %$where;
+  my @c_cols = $self->result_source->unique_constraint_columns($constraint_name);
 
-  my (@unique_queries, %seen_column_combinations);
-  foreach my $name (@constraint_names) {
-    my @constraint_cols = $self->result_source->unique_constraint_columns($name);
-
-    my $constraint_sig = join "\x00", sort @constraint_cols;
-    next if $seen_column_combinations{$constraint_sig}++;
-
-    my $unique_query = $self->_build_unique_query($query, \@constraint_cols);
+  # combination may fail if $self->{cond} is non-trivial
+  my ($final_cond) = try {
+    $self->_merge_with_rscond ($extra_cond)
+  } catch {
+    +{ %$extra_cond }
+  };
 
-    my $num_cols = scalar @constraint_cols;
-    my $num_query = scalar keys %$unique_query;
+  # trim out everything not in $columns
+  $final_cond = { map { $_ => $final_cond->{$_} } @c_cols };
 
-    my $total = $num_query + $num_where;
-    if ($num_query && ($num_query == $num_cols || $total == $num_cols)) {
-      # The query is either unique on its own or is unique in combination with
-      # the existing where clause
-      push @unique_queries, $unique_query;
-    }
+  if (my @missing = grep { ! defined $final_cond->{$_} } (@c_cols) ) {
+    $self->throw_exception( sprintf ( "Unable to satisfy constraint '%s', no values for column(s): %s",
+      $constraint_name,
+      join (', ', map { "'$_'" } @missing),
+    ) );
   }
 
-  return @unique_queries;
-}
-
-# _build_unique_query
-#
-# Constrain the specified query hash based on the specified column names.
-
-sub _build_unique_query {
-  my ($self, $query, $unique_cols) = @_;
-
-  return {
-    map  { $_ => $query->{$_} }
-    grep { exists $query->{$_} }
-      @$unique_cols
-  };
+  return $final_cond;
 }
 
 =head2 search_related
@@ -1703,7 +1698,7 @@ sub populate {
     }
 
     ## inherit the data locked in the conditions of the resultset
-    my ($rs_data) = $self->_merge_cond_with_data({});
+    my ($rs_data) = $self->_merge_with_rscond({});
     delete @{$rs_data}{@columns};
     my @inherit_cols = keys %$rs_data;
     my @inherit_data = values %$rs_data;
@@ -2010,7 +2005,7 @@ sub new_result {
   $self->throw_exception( "new_result needs a hash" )
     unless (ref $values eq 'HASH');
 
-  my ($merged_cond, $cols_from_relations) = $self->_merge_cond_with_data($values);
+  my ($merged_cond, $cols_from_relations) = $self->_merge_with_rscond($values);
 
   my %new = (
     %$merged_cond,
@@ -2024,13 +2019,13 @@ sub new_result {
   return $self->result_class->new(\%new);
 }
 
-# _merge_cond_with_data
+# _merge_with_rscond
 #
 # Takes a simple hash of K/V data and returns its copy merged with the
 # condition already present on the resultset. Additionally returns an
 # arrayref of value/condition names, which were inferred from related
 # objects (this is needed for in-memory related objects)
-sub _merge_cond_with_data {
+sub _merge_with_rscond {
   my ($self, $data) = @_;
 
   my (%new_data, @cols_from_relations);
@@ -2056,11 +2051,13 @@ sub _merge_cond_with_data {
     my %implied = %{$self->_remove_alias($collapsed_cond, $alias)};
 
     while ( my($col, $value) = each %implied ) {
-      if (ref($value) eq 'HASH' && keys(%$value) && (keys %$value)[0] eq '=') {
+      my $vref = ref $value;
+      if ($vref eq 'HASH' && keys(%$value) && (keys %$value)[0] eq '=') {
         $new_data{$col} = $value->{'='};
-        next;
       }
-      $new_data{$col} = $value if $self->_is_deterministic_value($value);
+      elsif( !$vref or $vref eq 'SCALAR' or blessed($value) ) {
+        $new_data{$col} = $value;
+      }
     }
   }
 
@@ -2072,20 +2069,6 @@ sub _merge_cond_with_data {
   return (\%new_data, \@cols_from_relations);
 }
 
-# _is_deterministic_value
-#
-# Make an effor to strip non-deterministic values from the condition,
-# to make sure new_result chokes less
-
-sub _is_deterministic_value {
-  my $self = shift;
-  my $value = shift;
-  my $ref_type = ref $value;
-  return 1 if $ref_type eq '' || $ref_type eq 'SCALAR';
-  return 1 if blessed $value;
-  return 0;
-}
-
 # _has_resolved_attr
 #
 # determines if the resultset defines at least one
@@ -2243,17 +2226,18 @@ sub as_query {
   $cd->cd_to_producer->find_or_new({ producer => $producer },
                                    { key => 'primary });
 
-Find an existing record from this resultset, based on its primary
-key, or a unique constraint. If none exists, instantiate a new result
-object and return it. The object will not be saved into your storage
-until you call L<DBIx::Class::Row/insert> on it.
+Find an existing record from this resultset using L</find>. if none exists,
+instantiate a new result object and return it. The object will not be saved
+into your storage until you call L<DBIx::Class::Row/insert> on it.
 
-You most likely want this method when looking for existing rows using
-a unique constraint that is not the primary key, or looking for
-related rows.
+You most likely want this method when looking for existing rows using a unique
+constraint that is not the primary key, or looking for related rows.
 
-If you want objects to be saved immediately, use L</find_or_create>
-instead.
+If you want objects to be saved immediately, use L</find_or_create> instead.
+
+B<Note>: Make sure to read the documentation of L</find> and understand the
+significance of the C<key> attribute, as its lack may skew your search, and
+subsequently result in spurious new objects.
 
 B<Note>: Take care when using C<find_or_new> with a table having
 columns with default values that you intend to be automatically
@@ -2395,6 +2379,10 @@ constraint. For example:
     { key => 'cd_artist_title' }
   );
 
+B<Note>: Make sure to read the documentation of L</find> and understand the
+significance of the C<key> attribute, as its lack may skew your search, and
+subsequently result in spurious row creation.
+
 B<Note>: Because find_or_create() reads from the database and then
 possibly inserts based on the result, this method is subject to a race
 condition. Another process could create a record in the table after
@@ -2428,16 +2416,15 @@ sub find_or_create {
 
 =item Arguments: \%col_values, { key => $unique_constraint }?
 
-=item Return Value: $rowobject
+=item Return Value: $row_object
 
 =back
 
   $resultset->update_or_create({ col => $val, ... });
 
-First, searches for an existing row matching one of the unique constraints
-(including the primary key) on the source of this resultset. If a row is
-found, updates it with the other given column values. Otherwise, creates a new
-row.
+Like L</find_or_create>, but if a row is found it is immediately updated via
+C<< $found_row->update (\%col_values) >>.
+
 
 Takes an optional C<key> attribute to search on a specific unique constraint.
 For example:
@@ -2459,14 +2446,9 @@ For example:
     key => 'primary',
   });
 
-
-If no C<key> is specified, 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.
-
-See also L</find> and L</find_or_create>. For information on how to declare
-unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
+B<Note>: Make sure to read the documentation of L</find> and understand the
+significance of the C<key> attribute, as its lack may skew your search, and
+subsequently result in spurious row creation.
 
 B<Note>: Take care when using C<update_or_create> with a table having
 columns with default values that you intend to be automatically
@@ -2474,6 +2456,9 @@ supplied by the database (e.g. an auto_increment primary key column).
 In normal usage, the value of such columns should NOT be included at
 all in the call to C<update_or_create>, even when set to C<undef>.
 
+See also L</find> and L</find_or_create>. For information on how to declare
+unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
+
 =cut
 
 sub update_or_create {
@@ -2502,13 +2487,9 @@ sub update_or_create {
 
   $resultset->update_or_new({ col => $val, ... });
 
-First, searches for an existing row matching one of the unique constraints
-(including the primary key) on the source of this resultset. If a row is
-found, updates it with the other given column values. Otherwise, instantiate
-a new result object and return it. The object will not be saved into your storage
-until you call L<DBIx::Class::Row/insert> on it.
+Like L</find_or_new> but if a row is found it is immediately updated via
+C<< $found_row->update (\%col_values) >>.
 
-Takes an optional C<key> attribute to search on a specific unique constraint.
 For example:
 
   # In your application
@@ -2529,13 +2510,17 @@ For example:
       $cd->insert;
   }
 
+B<Note>: Make sure to read the documentation of L</find> and understand the
+significance of the C<key> attribute, as its lack may skew your search, and
+subsequently result in spurious new objects.
+
 B<Note>: Take care when using C<update_or_new> with a table having
 columns with default values that you intend to be automatically
 supplied by the database (e.g. an auto_increment primary key column).
 In normal usage, the value of such columns should NOT be included at
 all in the call to C<update_or_new>, even when set to C<undef>.
 
-See also L</find>, L</find_or_create> and L</find_or_new>.
+See also L</find>, L</find_or_create> and L</find_or_new>. 
 
 =cut
 
index 215c033..f063cb3 100644 (file)
@@ -122,16 +122,10 @@ is($new_again->ID, 'DBICTest::Artist|artist|artistid=4', 'unique object id gener
   $artist->delete;
 }
 
-# Test backwards compatibility
-{
-  my $warnings = '';
-  local $SIG{__WARN__} = sub { $warnings .= $_[0] };
-
-  my $artist_by_hash = $schema->resultset('Artist')->find(artistid => 4);
-  is($artist_by_hash->name, 'Man With A Spoon', 'Retrieved correctly');
-  is($artist_by_hash->ID, 'DBICTest::Artist|artist|artistid=4', 'unique object id generated correctly');
-  like($warnings, qr/deprecated/, 'warned about deprecated find usage');
-}
+# this has been warning for 4 years, killing
+throws_ok {
+  $schema->resultset('Artist')->find(artistid => 4);
+} qr|expects either a column/value hashref, or a list of values corresponding to the columns of the specified unique constraint|;
 
 is($schema->resultset("Artist")->count, 4, 'count ok');
 
index 8479494..e7f4249 100644 (file)
@@ -1,15 +1,14 @@
 use strict;
-use warnings;  
+use warnings;
 
 use Test::More;
 use Test::Warn;
+use Test::Exception;
 use lib qw(t/lib);
 use DBICTest;
 
 my $schema = DBICTest->init_schema();
 
-plan tests => 20;
-
 my $art = $schema->resultset("Artist")->find(4);
 ok(!defined($art), 'Find on primary id: artist not found');
 my @cd = $schema->resultset("CD")->find(6);
@@ -51,13 +50,23 @@ my $artist_rs = $schema->resultset("Artist")->search({ artistid => $cd->artist->
 $art = $artist_rs->find({ name => 'some other name' }, { key => 'primary' });
 ok($art, 'Artist found by key in the resultset');
 
+# collapsing and non-collapsing are separate codepaths, thus the separate tests
+
 $artist_rs = $schema->resultset("Artist");
-warning_is {
-  $artist_rs->find({}, { key => 'primary' })
-} "DBIx::Class::ResultSet::find(): Query returned more than one row.  SQL that returns multiple rows is DEPRECATED for ->find and ->single"
+warnings_exist {
+  $artist_rs->find({})
+} qr/\QDBIx::Class::ResultSet::find(): Query returned more than one row.  SQL that returns multiple rows is DEPRECATED for ->find and ->single/
     =>  "Non-unique find generated a cursor inexhaustion warning";
+throws_ok {
+  $artist_rs->find({}, { key => 'primary' })
+} qr/Unable to satisfy constraint 'primary'/;
 
 $artist_rs = $schema->resultset("Artist")->search({}, { prefetch => 'cds' });
-warning_is {
+warnings_exist {
+  $artist_rs->find({})
+} qr/\QDBIx::Class::ResultSet::find(): Query returned more than one row/, "Non-unique find generated a cursor inexhaustion warning";
+throws_ok {
   $artist_rs->find({}, { key => 'primary' })
-} "DBIx::Class::ResultSet::find(): Query returned more than one row", "Non-unique find generated a cursor inexhaustion warning";
+} qr/Unable to satisfy constraint 'primary'/;
+
+done_testing;
index 67911aa..f9f61c4 100644 (file)
--- a/t/72pg.t
+++ b/t/72pg.t
@@ -225,13 +225,23 @@ for my $use_insert_returning ($test_server_supports_insert_returning
       arrayfield => [5, 6],
     });
 
+    my $afield_rs = $schema->resultset('ArrayTest')->search({
+      arrayfield => \[ '= ?' => [arrayfield => [3, 4]] ],   #Todo anything less ugly than this?
+    });
+
     my $count;
     lives_ok {
-      $count = $schema->resultset('ArrayTest')->search({
-        arrayfield => \[ '= ?' => [arrayfield => [3, 4]] ],   #Todo anything less ugly than this?
-      })->count;
+      $count = $afield_rs->count
     } 'comparing arrayref to pg array data does not blow up';
     is($count, 1, 'comparing arrayref to pg array data gives correct result');
+
+    TODO: {
+      local $TODO = 'No introspection of scalarref conditions :(';
+      my $row = $afield_rs->create({});
+      is_deeply ($row->arrayfield, [3,4], 'Array value taken from $rs condition');
+      $row->discard_changes;
+      is_deeply ($row->arrayfield, [3,4], 'Array value made it to storage');
+    }
   }
 
 
index dfd7819..7f78ef5 100644 (file)
@@ -3,6 +3,7 @@ use warnings;
 
 use Test::More;
 use Test::Exception;
+use Test::Warn;
 use lib qw(t/lib);
 use DBICTest;
 use DBIC::SqlMakerTest;
@@ -132,6 +133,12 @@ is($cd8->get_column('artist'), $cd1->get_column('artist'), 'artist is correct');
 is($cd8->title, $cd1->title, 'title is correct');
 is($cd8->year, $cd1->year, 'year is correct');
 
+# Add an extra row to potentially confuse the query
+$schema->resultset('CD')->create ({
+  artist => 2,
+  title => $title,
+  year => 2022,
+});
 my $cd9 = $artist->cds->update_or_create(
   {
     cdid   => $cd1->cdid,
@@ -222,6 +229,8 @@ is($row->baz, 3, 'baz is correct');
   my $artist = $schema->resultset('Artist')->next;
 
   my ($sql, @bind);
+  my $old_debugobj = $schema->storage->debugobj;
+  my $old_debug = $schema->storage->debug;
   $schema->storage->debugobj(DBIC::DebugObj->new(\$sql, \@bind)),
   $schema->storage->debug(1);
 
@@ -234,8 +243,8 @@ is($row->baz, 3, 'baz is correct');
     [qw/'1'/],
   );
 
-  $schema->storage->debug(0);
-  $schema->storage->debugobj(undef);
+  $schema->storage->debug($old_debug);
+  $schema->storage->debugobj($old_debugobj);
 }
 
 {
@@ -260,7 +269,22 @@ MOD
   } qr/\Qadd_unique_constraint() does not accept multiple constraints, use add_unique_constraints() instead\E/,
     'add_unique_constraint throws when more than one constraint specified';
 }
+# make sure NULL is not considered condition-deterministic
+my $art_rs = $schema->resultset('Artist')->search({}, { order_by => 'artistid' });
+$art_rs->create ({ artistid => $_ + 640, name => "Outranked $_" }) for (1..2);
+warnings_are {
+  is(
+    $art_rs->find ({ artistid => 642, rank => 13, charfield => undef })->name,
+    'Outranked 2',
+    'Correct artist retrieved with find'
+  );
 
+  is (
+    $art_rs->search({ charfield => undef })->find ({ artistid => 642, rank => 13 })->name,
+    'Outranked 2',
+    'Correct artist retrieved with find'
+  );
+} [], 'no warnings';
 
 done_testing;
 
index 0eab861..a6be997 100644 (file)
@@ -10,8 +10,6 @@ my ($dsn, $dbuser, $dbpass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER PASS/}
 plan skip_all => 'Set $ENV{DBICTEST_PG_DSN}, _USER and _PASS to run this test'
   unless ($dsn && $dbuser);
 
-plan tests => 6;
-
 my $schema = DBICTest::Schema->connection($dsn, $dbuser, $dbpass, { AutoCommit => 1 });
 
 my $dbh = $schema->storage->dbh;
@@ -82,6 +80,15 @@ my $new;
       $schema->txn_rollback;
     });
   }
+
+  # create with blob from $rs
+  $new = $rs->create({});
+  is($new->bytea, $big_long_string, 'Object has bytea value from $rs');
+  $new->discard_changes;
+  is($new->bytea, $big_long_string, 'bytea value made it to db');
 }
 
-$dbh->do("DROP TABLE bindtype_test");
+done_testing;
+
+eval { $dbh->do("DROP TABLE bindtype_test") };
+
index 62bd946..b089287 100644 (file)
@@ -32,6 +32,7 @@ __PACKAGE__->add_columns(
 __PACKAGE__->set_primary_key('artistid');
 __PACKAGE__->add_unique_constraint(['name']);
 __PACKAGE__->add_unique_constraint(artist => ['artistid']); # do not remove, part of a test
+__PACKAGE__->add_unique_constraint(u_nullable => [qw/charfield rank/]);
 
 
 __PACKAGE__->mk_classdata('field_name_for', {
index e53bb23..9178263 100644 (file)
@@ -1,6 +1,6 @@
 -- 
 -- Created by SQL::Translator::Producer::SQLite
--- Created on Sat Oct 16 16:17:01 2010
+-- Created on Sun Oct 17 01:51:06 2010
 -- 
 
 --
@@ -17,6 +17,8 @@ CREATE INDEX artist_name_hookidx ON artist (name);
 
 CREATE UNIQUE INDEX artist_name ON artist (name);
 
+CREATE UNIQUE INDEX u_nullable ON artist (charfield, rank);
+
 --
 -- Table: bindtype_test
 --
index 56936f8..6bb0e86 100644 (file)
@@ -3,6 +3,7 @@ use warnings;
 
 use Test::More;
 use Test::Exception;
+use Test::Warn;
 use lib qw(t/lib);
 use DBICTest;
 use DBIC::SqlMakerTest;
@@ -10,14 +11,13 @@ use DBIC::SqlMakerTest;
 my $schema = DBICTest->init_schema();
 my $sdebug = $schema->storage->debug;
 
-plan tests => 6;
-
 my $artist = $schema->resultset ('Artist')->first;
 
 my $genre = $schema->resultset ('Genre')
             ->create ({ name => 'par excellence' });
+my $genre_cds = $genre->cds;
 
-is ($genre->search_related( 'cds' )->count, 0, 'No cds yet');
+is ($genre_cds->count, 0, 'No cds yet');
 
 # expect a create
 $genre->update_or_create_related ('cds', {
@@ -27,8 +27,8 @@ $genre->update_or_create_related ('cds', {
 });
 
 # verify cd was inserted ok
-is ($genre->search_related( 'cds' )->count, 1, 'One cd');
-my $cd = $genre->find_related ('cds', {});
+is ($genre_cds->count, 1, 'One cd');
+my $cd = $genre_cds->first;
 is_deeply (
   { map { $_, $cd->get_column ($_) } qw/artist year title/ },
   {
@@ -40,15 +40,16 @@ is_deeply (
 );
 
 # expect a year update on the only related row
-# (non-qunique column + unique column as disambiguator)
+# (non-qunique column + unique column set as disambiguator)
 $genre->update_or_create_related ('cds', {
   year => 2010,
   title => 'the best thing since sliced bread',
+  artist => 1,
 });
 
 # re-fetch the cd, verify update
 is ($genre->search_related( 'cds' )->count, 1, 'Still one cd');
-$cd = $genre->find_related ('cds', {});
+$cd = $genre_cds->first;
 is_deeply (
   { map { $_, $cd->get_column ($_) } qw/artist year title/ },
   {
@@ -59,6 +60,16 @@ is_deeply (
   'CD year column updated correctly',
 );
 
+# expect a failing create:
+# the unique constraint is not complete, and there is nothing
+# in the database with such a year yet - insertion will fail due
+# to missing artist fk
+throws_ok {
+  $genre->update_or_create_related ('cds', {
+    year => 2020,
+    title => 'the best thing since sliced bread',
+  })
+} qr/\Qcd.artist may not be NULL/, 'ambiguous find + create failed';
 
 # expect a create, after a failed search using *only* the
 # *current* relationship and the unique column constraints
@@ -88,3 +99,5 @@ is_same_sql (
 
 # a has_many search without a unique constraint makes no sense
 # but I am not sure what to test for - leaving open
+
+done_testing;