# 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
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;
-
- # Parse out a hashref from input
+ # Parse out a query from input
my $input_query;
if (ref $_[0] eq 'HASH') {
$input_query = { %{$_[0]} };
}
- elsif (@_ == @cols) {
- $input_query = {};
- @{$input_query}{@cols} = @_;
- }
else {
- # Compatibility: Allow e.g. find(id => $value)
- carp "Find by key => value deprecated; please use a hashref instead";
- $input_query = {@_};
- }
+ my $constraint = exists $attrs->{key} ? $attrs->{key} : 'primary';
+ my @c_cols = $self->result_source->unique_constraint_columns($constraint);
+
+ $self->throw_exception(
+ "No constraint columns, maybe a malformed '$constraint' constraint?"
+ ) unless @c_cols;
- my (%related, $info);
+ $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 == @_;
+
+ $input_query = {};
+ @{$input_query}{@c_cols} = @_;
+ }
- KEY: foreach my $key (keys %$input_query) {
- if (ref($input_query->{$key})
- && ($info = $self->result_source->relationship_info($key))) {
+ my %related;
+ for my $key (keys %$input_query) {
+ if (
+ my $keyref = ref($input_query->{$key})
+ and
+ my $relinfo = $self->result_source->relationship_info($key)
+ ) {
my $val = delete $input_query->{$key};
- next KEY if (ref($val) eq 'ARRAY'); # has_many for multi_create
+
+ next if $keyref 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';
+ $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 (?)
+ @{$input_query}{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
# relationship
}
else {
+ # no key was specified - fall down to heuristics mode
+ # get all possible unique queries based on the combination of $query
+ # and the condition available in $self, and then run a search with
+ # each and every possible constraint (as long as it's completely specified)
my @unique_queries = $self->_unique_queries($input_query, $attrs);
$query = @unique_queries
? [ map { $self->_add_alias($_, $alias) } @unique_queries ]
# _unique_queries
#
-# Build a list of queries which satisfy unique constraints.
+# Build a list of queries which satisfy the unique constraint(s) as per $attrs
sub _unique_queries {
my ($self, $query, $attrs) = @_;
}
}
-# XXX: Disabled since it doesn't infer uniqueness in all cases
-# unless ($self->_is_unique_query($attrs->{where})) {
-# carp "Query not guaranteed 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
}
-# _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);
- my $alias = $self->{attrs}{alias};
-
- foreach my $name ($self->result_source->unique_constraint_names) {
- my @unique_cols = map {
- "$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 =~ /\./ ? $key : "$alias.$key";
- next unless exists $seen{$aliased}; # Additional constraints are okay
- $seen{$aliased} = scalar keys %{ $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.