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
=item Return Value: $rs
-=item
-
=back
The resultset constructor. Takes a source object (usually a
# year = 2005 OR year = 2004
If you need to pass in additional attributes but no additional condition,
-call it as C<search(undef, \%attrs);>.
+call it as C<search(undef, \%attrs)>.
# "SELECT name, artistid FROM $artist_table"
my @all_artists = $schema->resultset('Artist')->search(undef, {
=over 4
-=item Arguments: (@values | \%cols), \%attrs?
+=item Arguments: @values | \%cols, \%attrs?
=item Return Value: $row_object
=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 key or unique constraint by specifying
+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
my ($self, @vals) = @_;
my $attrs = (@vals > 1 && ref $vals[$#vals] eq 'HASH' ? pop(@vals) : {});
- my @cols = $self->result_source->primary_columns;
- if (exists $attrs->{key}) {
- my %uniq = $self->result_source->unique_constraints;
+ # Build a list of queries
+ my @unique_hashes;
+
+ if (ref $vals[0] eq 'HASH') {
+ my @constraint_names = exists $attrs->{key}
+ ? ($attrs->{key})
+ : $self->result_source->unique_constraint_names;
$self->throw_exception(
- "Unknown key $attrs->{key} on '" . $self->result_source->name . "'"
- ) unless exists $uniq{$attrs->{key}};
- @cols = @{ $uniq{$attrs->{key}} };
+ "Can't find by explicitly named columns unless a primary key or unique constraint is defined"
+ ) unless @constraint_names;
+
+ foreach my $name (@constraint_names) {
+ my @unique_cols = $self->result_source->unique_constraint_columns($name);
+ my $unique_hash = $self->_unique_hash($vals[0], \@unique_cols);
+
+ # TODO: Check that the ResultSet defines the rest of the query
+ push @unique_hashes, $unique_hash
+ if scalar keys %$unique_hash;# == scalar @unique_cols;
+ }
}
- #use Data::Dumper; warn Dumper($attrs, @vals, @cols);
- $self->throw_exception(
- "Can't find unless a primary key or unique constraint is defined"
- ) unless @cols;
+ else {
+ my @unique_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 a unique constraint is specified"
+ ) unless @unique_cols;
- my $query;
- if (ref $vals[0] eq 'HASH') {
- $query = { %{$vals[0]} };
- } elsif (@cols == @vals) {
- $query = {};
- @{$query}{@cols} = @vals;
- } else {
- $query = {@vals};
+ if (@vals == @unique_cols) {
+ my %unique_hash;
+ @unique_hash{@unique_cols} = @vals;
+ push @unique_hashes, \%unique_hash;
+ }
+ else {
+ # Hack for CDBI queries
+ my %hash = @vals;
+ push @unique_hashes, \%hash;
+ }
}
- foreach my $key (grep { ! m/\./ } keys %$query) {
- $query->{"$self->{attrs}{alias}.$key"} = delete $query->{$key};
+
+ # Add the ResultSet's alias
+ foreach my $unique_hash (@unique_hashes) {
+ foreach my $key (grep { ! m/\./ } keys %$unique_hash) {
+ $unique_hash->{"$self->{attrs}{alias}.$key"} = delete $unique_hash->{$key};
+ }
}
- #warn Dumper($query);
-
+
+ # Handle cases where the ResultSet already defines the query
+ my $query = @unique_hashes ? \@unique_hashes : undef;
+
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);
}
}
+# _unique_hash
+#
+# Constrain the specified hash based on the specific column names.
+
+sub _unique_hash {
+ my ($self, $hash, $unique_cols) = @_;
+
+ # Ugh, CDBI lowercases column names
+ if (exists $INC{'DBIx/Class/CDBICompat/ColumnCase.pm'}) {
+ foreach my $key (keys %$hash) {
+ $hash->{lc $key} = delete $hash->{$key};
+ }
+ }
+
+ my %unique_hash =
+ map { $_ => $hash->{$_} }
+ grep { exists $hash->{$_} }
+ @$unique_cols;
+
+ return \%unique_hash;
+}
+
=head2 search_related
=over 4
name => 'Emo-R-Us',
});
-Search the specified relationship, optionally specify a condition and
+Searches the specified relationship, optionally specifying a condition and
attributes for matching records. See L</ATTRIBUTES> for more information.
=cut
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
# WHERE title LIKE '%blue%'
$cd_rs = $rs->search_like({ title => '%blue%'});
-Perform a search, but use C<LIKE> instead of C<=> as the condition. Note
+Performs a search, but uses C<LIKE> instead of C<=> as the condition. Note
that this is simply a convenience method. You most likely want to use
L</search> with specific operators.
=back
Returns a resultset or object list representing a subset of elements from the
-resultset slice is called on. Indexes are from 0 - i.e. to get the first
-three records, call
+resultset slice is called on. Indexes are from 0, i.e., to get the first
+three records, call:
my ($one, $two, $three) = $rs->slice(0, 2);
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);
=over 4
-=item Arguments: ($cond, \%attrs?)?
+=item Arguments: $cond, \%attrs??
=item Return Value: $count
@distinct = ($column);
last;
}
- }
+ }
}
$select = { count => { distinct => \@distinct } };
=back
Resets the resultset and returns an object for the first result (if the
-resultset contains anything).
+resultset returns anything).
=cut
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
);
}
=back
-Fetches all objects and updates them one at a time. Note that C<update_all>
-will run cascade triggers while L</update> will not.
+Fetches all objects and updates them one at a time. Note that C<update_all>
+will run DBIC cascade triggers, while L</update> will not.
=cut
=back
Deletes the contents of the resultset from its result source. Note that this
-will not run cascade triggers. See L</delete_all> if you need triggers to run.
+will not run DBIC cascade triggers. See L</delete_all> if you need triggers
+to run.
=cut
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};
- }
- }
+ my $cond = $self->_cond_for_update_delete;
- } else {
- $self->throw_exception(
- "Can't delete on resultset with condition unless hash or array"
- );
- }
-
- $self->result_source->storage->delete($self->result_source->from, $del);
+ $self->result_source->storage->delete($self->result_source->from, $cond);
return 1;
}
=back
-Fetches all objects and deletes them one at a time. Note that C<delete_all>
-will run cascade triggers while L</delete> will not.
+Fetches all objects and deletes them one at a time. Note that C<delete_all>
+will run DBIC cascade triggers, while L</delete> will not.
=cut
Returns a resultset for the $page_number page of the resultset on which page
is called, where each page contains a number of rows equal to the 'rows'
-attribute set on the resultset, or 10 by default
+attribute set on the resultset (10 by default).
=cut
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
$class->update_or_create({ col => $val, ... });
-First, search 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, update it with the other given column values. Otherwise, create a new
+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.
Takes an optional C<key> attribute to search on a specific unique constraint.
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>, search only on 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>.
+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
-Gets the contents of the cache for the resultset if the cache is set
+Gets the contents of the cache for the resultset, if the cache is set.
=cut
=item Value: ($order_by | \@order_by)
+=back
+
Which column(s) to order the results by. This is currently passed
through directly to SQL, so you can give e.g. C<year DESC> for a
descending order on the column `year'.
=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.