use Storable;
use Scalar::Util qw/weaken/;
+use DBIx::Class::ResultSetColumn;
use base qw/DBIx::Class/;
__PACKAGE__->load_components(qw/AccessorGroup/);
__PACKAGE__->mk_group_accessors('simple' => qw/result_source result_class/);
=head1 METHODS
-=head2 new
+=head2 new
=over 4
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' }
);
-See also L</find_or_create> and L</update_or_create>.
+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.
+
+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>.
=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(@_) : {});
+
+ # 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 @cols = $self->result_source->primary_columns;
- if (exists $attrs->{key}) {
- my %uniq = $self->result_source->unique_constraints;
+ 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 $uniq{$attrs->{key}};
- @cols = @{ $uniq{$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"
+ );
}
- #use Data::Dumper; warn Dumper($attrs, @vals, @cols);
+
+ # 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 @cols;
-
- my $query;
- if (ref $vals[0] eq 'HASH') {
- $query = { %{$vals[0]} };
- } elsif (@cols == @vals) {
- $query = {};
- @{$query}{@cols} = @vals;
- } else {
- $query = {@vals};
- }
- foreach my $key (grep { ! m/\./ } keys %$query) {
- $query->{"$self->{attrs}{alias}.$key"} = delete $query->{$key};
+ ) 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);
+
+ # Add the ResultSet's alias
+ foreach my $key (grep { ! m/\./ } keys %$unique_query) {
+ $unique_query->{"$self->{attrs}{alias}.$key"} = delete $unique_query->{$key};
+ }
+
+ push @unique_queries, $unique_query if %$unique_query;
}
- #warn Dumper($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);
- return keys %{$rs->{collapse}} ? $rs->next : $rs->single;
- } else {
- return keys %{$self->{collapse}} ?
- $self->search($query)->next :
- $self->single($query);
+ my $rs = $self->search($query, $attrs);
+ return keys %{$rs->{collapse}} ? $rs->next : $rs->single;
}
+ else {
+ return keys %{$self->{collapse}}
+ ? $self->search($query)->next
+ : $self->single($query);
+ }
+}
+
+# _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
my $cd = $schema->resultset('CD')->single({ year => 2001 });
Inflates the first result without creating a cursor if the resultset has
-any records in it; if not returns nothing. Used by find() as an optimisation.
+any records in it; if not returns nothing. Used by L</find> as an optimisation.
=cut
if ($where) {
if (defined $attrs->{where}) {
$attrs->{where} = {
- '-and' =>
+ '-and' =>
[ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
$where, delete $attrs->{where} ]
};
return (@data ? $self->_construct_object(@data) : ());
}
+=head2 get_column
+
+=over 4
+
+=item Arguments: $cond?
+
+=item Return Value: $resultsetcolumn
+
+=back
+
+ my $max_length = $rs->get_column('length')->max;
+
+Returns a ResultSetColumn instance for $column based on $self
+
+=cut
+
+sub get_column {
+ my ($self, $column) = @_;
+
+ my $new = DBIx::Class::ResultSetColumn->new($self, $column);
+ return $new;
+}
=head2 search_like
sub slice {
my ($self, $min, $max) = @_;
- my $attrs = { %{ $self->{attrs} || {} } };
- $attrs->{offset} ||= 0;
+ my $attrs = {}; # = { %{ $self->{attrs} || {} } };
+ $attrs->{offset} = $self->{attrs}{offset} || 0;
$attrs->{offset} += $min;
$attrs->{rows} = ($max ? ($max - $min + 1) : 1);
- my $slice = (ref $self)->new($self->result_source, $attrs);
- return (wantarray ? $slice->all : $slice);
+ return $self->search(undef(), $attrs);
+ #my $slice = (ref $self)->new($self->result_source, $attrs);
+ #return (wantarray ? $slice->all : $slice);
}
=head2 next
print $cd->title;
}
+Note that you need to store the resultset object, and call C<next> on it.
+Calling C<< resultset('Table')->next >> repeatedly will always return the
+first record from the resultset.
+
=cut
sub next {
return ($self->all)[0];
}
my @row = (exists $self->{stashed_row} ?
- @{delete $self->{stashed_row}} :
- $self->cursor->next
+ @{delete $self->{stashed_row}} :
+ $self->cursor->next
);
# warn Dumper(\@row); use Data::Dumper;
return unless (@row);
my @collapse;
if (defined $prefix) {
@collapse = map {
- m/^\Q${prefix}.\E(.+)$/ ? ($1) : ()
+ m/^\Q${prefix}.\E(.+)$/ ? ($1) : ()
} keys %{$self->{collapse}}
} else {
@collapse = keys %{$self->{collapse}};
my (@final, @raw);
while ( !(grep {
!defined($tree->[0]->{$_}) ||
- $co_check{$_} ne $tree->[0]->{$_}
+ $co_check{$_} ne $tree->[0]->{$_}
} @co_key) ) {
push(@final, $tree);
last unless (@raw = $self->cursor->next);
@distinct = ($column);
last;
}
- }
+ }
}
$select = { count => { distinct => \@distinct } };
return $_[0]->reset->next;
}
+# _cond_for_update_delete
+#
+# update/delete require the condition to be modified to handle
+# the differing SQL syntax available. This transforms the $self->{cond}
+# appropriately, returning the new condition.
+
+sub _cond_for_update_delete {
+ my ($self) = @_;
+ my $cond = {};
+
+ if (!ref($self->{cond})) {
+ # No-op. No condition, we're updating/deleting everything
+ }
+ elsif (ref $self->{cond} eq 'ARRAY') {
+ $cond = [
+ map {
+ my %hash;
+ foreach my $key (keys %{$_}) {
+ $key =~ /([^.]+)$/;
+ $hash{$1} = $_->{$key};
+ }
+ \%hash;
+ } @{$self->{cond}}
+ ];
+ }
+ elsif (ref $self->{cond} eq 'HASH') {
+ if ((keys %{$self->{cond}})[0] eq '-and') {
+ $cond->{-and} = [];
+
+ my @cond = @{$self->{cond}{-and}};
+ for (my $i = 0; $i < @cond - 1; $i++) {
+ my $entry = $cond[$i];
+
+ my %hash;
+ if (ref $entry eq 'HASH') {
+ foreach my $key (keys %{$entry}) {
+ $key =~ /([^.]+)$/;
+ $hash{$1} = $entry->{$key};
+ }
+ }
+ else {
+ $entry =~ /([^.]+)$/;
+ $hash{$entry} = $cond[++$i];
+ }
+
+ push @{$cond->{-and}}, \%hash;
+ }
+ }
+ else {
+ foreach my $key (keys %{$self->{cond}}) {
+ $key =~ /([^.]+)$/;
+ $cond->{$1} = $self->{cond}{$key};
+ }
+ }
+ }
+ else {
+ $self->throw_exception(
+ "Can't update/delete on resultset with condition unless hash or array"
+ );
+ }
+
+ return $cond;
+}
+
+
=head2 update
=over 4
my ($self, $values) = @_;
$self->throw_exception("Values for update must be a hash")
unless ref $values eq 'HASH';
+
+ my $cond = $self->_cond_for_update_delete;
+
return $self->result_source->storage->update(
- $self->result_source->from, $values, $self->{cond}
+ $self->result_source->from, $values, $cond
);
}
my ($self) = @_;
my $del = {};
- if (!ref($self->{cond})) {
-
- # No-op. No condition, we're deleting everything
-
- } elsif (ref $self->{cond} eq 'ARRAY') {
-
- $del = [ map { my %hash;
- foreach my $key (keys %{$_}) {
- $key =~ /([^.]+)$/;
- $hash{$1} = $_->{$key};
- }; \%hash; } @{$self->{cond}} ];
-
- } elsif (ref $self->{cond} eq 'HASH') {
-
- if ((keys %{$self->{cond}})[0] eq '-and') {
-
- $del->{-and} = [ map { my %hash;
- foreach my $key (keys %{$_}) {
- $key =~ /([^.]+)$/;
- $hash{$1} = $_->{$key};
- }; \%hash; } @{$self->{cond}{-and}} ];
-
- } else {
-
- foreach my $key (keys %{$self->{cond}}) {
- $key =~ /([^.]+)$/;
- $del->{$1} = $self->{cond}{$key};
- }
- }
-
- } else {
- $self->throw_exception(
- "Can't delete on resultset with condition unless hash or array"
- );
- }
+ my $cond = $self->_cond_for_update_delete;
- $self->result_source->storage->delete($self->result_source->from, $del);
+ $self->result_source->storage->delete($self->result_source->from, $cond);
return 1;
}
return $obj;
}
+=head2 find_or_new
+
+=over 4
+
+=item Arguments: \%vals, \%attrs?
+
+=item Return Value: $object
+
+=back
+
+Find an existing record from this resultset. 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.
+
+If you want objects to be saved immediately, use L</find_or_create> instead.
+
+=cut
+
+sub find_or_new {
+ my $self = shift;
+ my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
+ my $hash = ref $_[0] eq 'HASH' ? shift : {@_};
+ my $exists = $self->find($hash, $attrs);
+ return defined $exists ? $exists : $self->new_result($hash);
+}
+
=head2 create
=over 4
{ key => 'artist_title' }
);
-See also L</find> and L</update_or_create>.
+See also L</find> and L</update_or_create>. For information on how to declare
+unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
=cut
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>.
+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
my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
my $hash = ref $_[0] eq 'HASH' ? shift : {@_};
- my %unique_constraints = $self->result_source->unique_constraints;
- my @constraint_names = (exists $attrs->{key}
- ? ($attrs->{key})
- : keys %unique_constraints);
-
- my @unique_hashes;
- foreach my $name (@constraint_names) {
- my @unique_cols = @{ $unique_constraints{$name} };
- my %unique_hash =
- map { $_ => $hash->{$_} }
- grep { exists $hash->{$_} }
- @unique_cols;
-
- push @unique_hashes, \%unique_hash
- if (scalar keys %unique_hash == scalar @unique_cols);
- }
-
- if (@unique_hashes) {
- my $row = $self->single(\@unique_hashes);
- if (defined $row) {
- $row->set_columns($hash);
- $row->update;
- return $row;
- }
+ my $row = $self->find($hash, $attrs);
+ if (defined $row) {
+ $row->set_columns($hash);
+ $row->update;
+ return $row;
}
return $self->create($hash);
=back
-Contains one or more relationships that should be fetched along with the main
+Contains one or more relationships that should be fetched along with the main
query (when they are accessed afterwards they will have already been
"prefetched"). This is useful for when you know you will need the related
objects, because it saves at least one query:
In simple terms, C<from> works as follows:
[
- { <alias> => <table>, -join-type => 'inner|left|right' }
+ { <alias> => <table>, -join_type => 'inner|left|right' }
[] # nested JOIN (optional)
{ <table.column> => <foreign_table.foreign_key> }
]
from => [
{ child => 'person' },
[
- { father => 'person', -join-type => 'inner' },
+ { father => 'person', -join_type => 'inner' },
{ 'father.id' => 'child.father_id' }
],
]
group_by => [qw/ column1 column2 ... /]
+=head2 having
+
+=over 4
+
+=item Value: $condition
+
+=back
+
+HAVING is a select statement attribute that is applied between GROUP BY and
+ORDER BY. It is applied to the after the grouping calculations have been
+done.
+
+ having => { 'count(employee)' => { '>=', 100 } }
+
=head2 distinct
=over 4
... do stuff ...
}
- $rs->first; # without cache, this would issue a query
+ $rs->first; # without cache, this would issue a query
By default, searches are not cached.