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:
artist => 'Massive Attack',
title => 'Mezzanine',
},
- { key => 'artist_title' }
+ { key => 'cd_artist_title' }
);
If the C<key> is specified as C<primary>, it searches only on the primary key.
) unless @cols;
# Parse out a hashref from input
- my $cond;
+ my $input_query;
if (ref $_[0] eq 'HASH') {
- $cond = { %{$_[0]} };
+ $input_query = { %{$_[0]} };
}
elsif (@_ == @cols) {
- $cond = {};
- @{$cond}{@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";
- $cond = {@_};
+ carp "Find by key => value deprecated; please use a hashref instead";
+ $input_query = {@_};
}
- return $self->_find($cond, $attrs);
+ 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->_resolve;
+ return (keys %{$self->{_attrs}->{collapse}})
+ ? $self->search($query)->next
+ : $self->single($query);
+ }
}
-# _find
+# _unique_queries
#
-# Helper method: search against the unique constraints.
+# Build a list of queries which satisfy unique constraints.
-sub _find {
- my ($self, $cond, $attrs) = @_;
+sub _unique_queries {
+ my ($self, $query, $attrs) = @_;
- # Check the condition against our source's unique constraints
my @constraint_names = exists $attrs->{key}
? ($attrs->{key})
: $self->result_source->unique_constraint_names;
- my @unique_conds;
+ my @unique_queries;
foreach my $name (@constraint_names) {
my @unique_cols = $self->result_source->unique_constraint_columns($name);
- my $unique_cond = $self->_build_unique_query($cond, \@unique_cols);
+ my $unique_query = $self->_build_unique_query($query, \@unique_cols);
- next unless scalar keys %$unique_cond == scalar @unique_cols;
+ next unless scalar keys %$unique_query;
# Add the ResultSet's alias
- foreach my $key (grep { ! m/\./ } keys %$unique_cond) {
- $unique_cond->{"$self->{attrs}{alias}.$key"} = delete $unique_cond->{$key};
+ foreach my $key (grep { ! m/\./ } keys %$unique_query) {
+ $unique_query->{"$self->{attrs}->{alias}.$key"} = delete $unique_query->{$key};
}
- push @unique_conds, $unique_cond;
+ push @unique_queries, $unique_query;
}
-# use Data::Dumper; warn Dumper $self->result_source->name, $cond, \@unique_conds;
- # Verify the query
- my $query = \@unique_conds;
- if (scalar @unique_conds == 0) {
- if (exists $attrs->{key}) {
- $self->throw_exception("required values for the $attrs->{key} key not provided");
- }
- else {
- # Compatibility: Allow broken find usage for now
- carp "find requires values for the primary key or a unique constraint"
- . "; please use search instead";
- $query = $cond;
- }
- }
-
- # 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
}
}
+ 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
$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,
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
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
sub update_or_create {
my $self = shift;
my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
- my $hash = ref $_[0] eq 'HASH' ? shift : {@_};
-
- my @constraint_names = exists $attrs->{key}
- ? ($attrs->{key})
- : $self->result_source->unique_constraint_names;
- $self->throw_exception(
- "update_or_create requires a primary key or unique constraint; none is defined on "
- . $self->result_source->name
- ) unless @constraint_names;
+ my $cond = ref $_[0] eq 'HASH' ? shift : {@_};
- 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);
-
- push @unique_queries, $unique_query
- if keys %$unique_query == @unique_cols;
- }
-
- if (@unique_queries) {
- my $row = $self->single(\@unique_queries);
- if (defined $row) {
- $row->update($hash);
- return $row;
- }
+ my $row = $self->find($cond);
+ if (defined $row) {
+ $row->update($cond);
+ return $row;
}
- return $self->create($hash);
+ return $self->create($cond);
}
=head2 get_cache
projects / dbsrgits/DBIx-Class.git / blobdiff