sub search {
my $self = shift;
-
- my $rs;
- if( @_ ) {
- my $attrs = { %{$self->{attrs}} };
- my $having = delete $attrs->{having};
- $attrs = { %$attrs, %{ pop(@_) } } if @_ > 1 and ref $_[$#_] eq 'HASH';
-
- my $where = (@_
- ? ((@_ == 1 || ref $_[0] eq "HASH")
- ? shift
- : ((@_ % 2)
- ? $self->throw_exception(
- "Odd number of arguments to search")
- : {@_}))
- : undef());
- if (defined $where) {
- $attrs->{where} = (defined $attrs->{where}
- ? { '-and' =>
- [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
- $where, $attrs->{where} ] }
- : $where);
- }
-
- if (defined $having) {
- $attrs->{having} = (defined $attrs->{having}
- ? { '-and' =>
- [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
- $having, $attrs->{having} ] }
- : $having);
- }
+ my $attrs = { %{$self->{attrs}} };
+ my $having = delete $attrs->{having};
+ $attrs = { %$attrs, %{ pop(@_) } } if @_ > 1 and ref $_[$#_] eq 'HASH';
+
+ my $where = (@_
+ ? ((@_ == 1 || ref $_[0] eq "HASH")
+ ? shift
+ : ((@_ % 2)
+ ? $self->throw_exception(
+ "Odd number of arguments to search")
+ : {@_}))
+ : undef());
+ if (defined $where) {
+ $attrs->{where} = (defined $attrs->{where}
+ ? { '-and' =>
+ [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
+ $where, $attrs->{where} ] }
+ : $where);
+ }
- $rs = (ref $self)->new($self->result_source, $attrs);
+ if (defined $having) {
+ $attrs->{having} = (defined $attrs->{having}
+ ? { '-and' =>
+ [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
+ $having, $attrs->{having} ] }
+ : $having);
}
- else {
- $rs = $self;
- $rs->reset;
+
+ my $rs = (ref $self)->new($self->result_source, $attrs);
+
+ unless (@_) { # no search, effectively just a clone
+ my $rows = $self->get_cache;
+ if( @{$rows} ) {
+ $rs->set_cache($rows);
+ }
}
+
return (wantarray ? $rs->all : $rs);
}
=back
-Finds a row based on its primary key or unique constraint. For example:
+Finds a row based on its primary key or unique constraint. For example, to find
+a row by its primary key:
my $cd = $schema->resultset('CD')->find(5);
-Also takes an optional C<key> attribute, to search by a specific key or unique
-constraint. For example:
+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' });
+
+Additionally, you can specify the columns explicitly by name:
my $cd = $schema->resultset('CD')->find(
{
{ key => 'artist_title' }
);
-If no C<key> is specified, it searches on all unique constraints defined on the
-source, including the primary key.
+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.
=cut
sub find {
- my ($self, @vals) = @_;
- my $attrs = (@vals > 1 && ref $vals[$#vals] eq 'HASH' ? pop(@vals) : {});
+ my $self = shift;
+ my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
- my %unique_constraints = $self->result_source->unique_constraints;
- $self->throw_exception(
- "Can't find unless a primary key or unique constraint is defined"
- ) unless %unique_constraints;
+ # Parse out a hash from input
+ my @cols = exists $attrs->{key}
+ ? $self->result_source->unique_constraint_columns($attrs->{key})
+ : $self->result_source->primary_columns;
- my @constraint_names = keys %unique_constraints;
- if (exists $attrs->{key}) {
+ my $hash;
+ if (ref $_[0] eq 'HASH') {
+ $hash = { %{$_[0]} };
+ }
+ elsif (@_ == @cols) {
+ $hash = {};
+ @{$hash}{@cols} = @_;
+ }
+ else {
$self->throw_exception(
- "Unknown key $attrs->{key} on '" . $self->result_source->name . "'"
- ) unless exists $unique_constraints{$attrs->{key}};
-
- @constraint_names = ($attrs->{key});
+ "Arguments to find must be a hashref or match the number of columns in the "
+ . exists $attrs->{key} ? "$attrs->{key} unique constraint" : "primary key"
+ );
}
- my @unique_hashes;
- foreach my $name (@constraint_names) {
- my @unique_cols = @{ $unique_constraints{$name} };
- my %unique_hash;
- if (ref $vals[0] eq 'HASH') {
- # Stupid hack for CDBICompat
- my %hash = %{ $vals[0] };
- foreach my $key (keys %hash) {
- $hash{lc $key} = delete $hash{$key};
- }
+ # 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;
- %unique_hash =
- map { $_ => $hash{$_} }
- grep { exists $hash{$_} }
- @unique_cols;
- }
- elsif (@unique_cols == @vals) {
- # Assume the argument order corresponds to the constraint definition
- @unique_hash{@unique_cols} = @vals;
- }
- elsif (@vals % 2 == 0) {
- # Fix for CDBI calling with a hash
- %unique_hash = @vals;
- }
+ 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);
- foreach my $key (grep { ! m/\./ } keys %unique_hash) {
- $unique_hash{"$self->{attrs}{alias}.$key"} = delete $unique_hash{$key};
+ # Add the ResultSet's alias
+ foreach my $key (grep { ! m/\./ } keys %$unique_query) {
+ $unique_query->{"$self->{attrs}{alias}.$key"} = delete $unique_query->{$key};
}
- #use Data::Dumper; warn Dumper \@vals, \@unique_cols, \%unique_hash;
- push @unique_hashes, \%unique_hash if %unique_hash;
+ push @unique_queries, $unique_query if %$unique_query;
}
# Handle cases where the ResultSet already defines the query
- my $query = @unique_hashes ? \@unique_hashes : undef;
+ my $query = @unique_queries ? \@unique_queries : undef;
+ # Run the query
if (keys %$attrs) {
my $rs = $self->search($query, $attrs);
return keys %{$rs->{collapse}} ? $rs->next : $rs->single;
}
}
+# _build_unique_query
+#
+# Constrain the specified query hash based on the specified column names.
+
+sub _build_unique_query {
+ my ($self, $query, $unique_cols) = @_;
+
+ my %unique_query =
+ map { $_ => $query->{$_} }
+ grep { exists $query->{$_} }
+ @$unique_cols;
+
+ return \%unique_query;
+}
+
=head2 search_related
=over 4
projects / dbsrgits/DBIx-Class-Historic.git / blobdiff