use strict;
use warnings;
use overload
- '0+' => 'count',
+ '0+' => \&count,
'bool' => sub { 1; },
fallback => 1;
use Data::Page;
use Storable;
+use Scalar::Util qw/weaken/;
use base qw/DBIx::Class/;
__PACKAGE__->load_components(qw/AccessorGroup/);
-__PACKAGE__->mk_group_accessors('simple' => 'result_source');
+__PACKAGE__->mk_group_accessors('simple' => qw/result_source result_class/);
=head1 NAME
=head1 SYNOPSIS
my $rs = $schema->resultset('User')->search(registered => 1);
- my @rows = $schema->resultset('Foo')->search(bar => 'baz');
+ my @rows = $schema->resultset('CD')->search(year => 2005);
=head1 DESCRIPTION
package MyApp::Schema::Artist;
use base qw/DBIx::Class/;
+ __PACKAGE__->load_components(qw/Core/);
__PACKAGE__->table('artist');
__PACKAGE__->add_columns(qw/artistid name/);
__PACKAGE__->set_primary_key('artistid');
package MyApp::Schema::CD;
use base qw/DBIx::Class/;
- __PACKAGE__->table('artist');
+ __PACKAGE__->load_components(qw/Core/);
+ __PACKAGE__->table('cd');
__PACKAGE__->add_columns(qw/cdid artist title year/);
__PACKAGE__->set_primary_key('cdid');
__PACKAGE__->belongs_to(artist => 'MyApp::Schema::Artist');
=head2 new
-=head3 Arguments: ($source, \%$attrs)
+=over 4
+
+=item Arguments: ($source, \%$attrs)
+
+=back
The resultset constructor. Takes a source object (usually a
-L<DBIx::Class::ResultSourceProxy::Table>) and an attribute hash (see L</ATRRIBUTES>
-below). Does not perform any queries -- these are executed as needed by the
-other methods.
+L<DBIx::Class::ResultSourceProxy::Table>) and an attribute hash (see
+L</ATTRIBUTES> below). Does not perform any queries -- these are
+executed as needed by the other methods.
Generally you won't need to construct a resultset manually. You'll
automatically get one from e.g. a L</search> called in scalar context:
sub new {
my $class = shift;
return $class->new_result(@_) if ref $class;
+
my ($source, $attrs) = @_;
- #use Data::Dumper; warn Dumper($attrs);
+ weaken $source;
$attrs = Storable::dclone($attrs || {}); # { %{ $attrs || {} } };
- my %seen;
+ #use Data::Dumper; warn Dumper($attrs);
my $alias = ($attrs->{alias} ||= 'me');
- if ($attrs->{cols} || !$attrs->{select}) {
- delete $attrs->{as} if $attrs->{cols};
- my @cols = ($attrs->{cols}
- ? @{delete $attrs->{cols}}
- : $source->columns);
- $attrs->{select} = [ map { m/\./ ? $_ : "${alias}.$_" } @cols ];
- }
- $attrs->{as} ||= [ map { m/^$alias\.(.*)$/ ? $1 : $_ } @{$attrs->{select}} ];
+
+ $attrs->{columns} ||= delete $attrs->{cols} if $attrs->{cols};
+ delete $attrs->{as} if $attrs->{columns};
+ $attrs->{columns} ||= [ $source->columns ] unless $attrs->{select};
+ $attrs->{select} = [
+ map { m/\./ ? $_ : "${alias}.$_" } @{delete $attrs->{columns}}
+ ] if $attrs->{columns};
+ $attrs->{as} ||= [
+ map { m/^\Q$alias.\E(.+)$/ ? $1 : $_ } @{$attrs->{select}}
+ ];
if (my $include = delete $attrs->{include_columns}) {
push(@{$attrs->{select}}, @$include);
- push(@{$attrs->{as}}, map { m/([^\.]+)$/; $1; } @$include);
+ push(@{$attrs->{as}}, map { m/([^.]+)$/; $1; } @$include);
}
#use Data::Dumper; warn Dumper(@{$attrs}{qw/select as/});
+
$attrs->{from} ||= [ { $alias => $source->from } ];
$attrs->{seen_join} ||= {};
+ my %seen;
if (my $join = delete $attrs->{join}) {
- foreach my $j (ref $join eq 'ARRAY'
- ? (@{$join}) : ($join)) {
+ foreach my $j (ref $join eq 'ARRAY' ? @$join : ($join)) {
if (ref $j eq 'HASH') {
$seen{$_} = 1 foreach keys %$j;
} else {
$seen{$j} = 1;
}
}
- push(@{$attrs->{from}}, $source->resolve_join($join, $attrs->{alias}, $attrs->{seen_join}));
+ push(@{$attrs->{from}}, $source->resolve_join(
+ $join, $attrs->{alias}, $attrs->{seen_join})
+ );
}
+
$attrs->{group_by} ||= $attrs->{select} if delete $attrs->{distinct};
+ $attrs->{order_by} = [ $attrs->{order_by} ] if
+ $attrs->{order_by} and !ref($attrs->{order_by});
+ $attrs->{order_by} ||= [];
+ my $collapse = $attrs->{collapse} || {};
if (my $prefetch = delete $attrs->{prefetch}) {
- foreach my $p (ref $prefetch eq 'ARRAY'
- ? (@{$prefetch}) : ($prefetch)) {
- if( ref $p eq 'HASH' ) {
+ my @pre_order;
+ foreach my $p (ref $prefetch eq 'ARRAY' ? @$prefetch : ($prefetch)) {
+ if ( ref $p eq 'HASH' ) {
foreach my $key (keys %$p) {
push(@{$attrs->{from}}, $source->resolve_join($p, $attrs->{alias}))
unless $seen{$key};
}
- }
- else {
+ } else {
push(@{$attrs->{from}}, $source->resolve_join($p, $attrs->{alias}))
unless $seen{$p};
}
- my @prefetch = $source->resolve_prefetch($p, $attrs->{alias});
- #die Dumper \@cols;
+ my @prefetch = $source->resolve_prefetch(
+ $p, $attrs->{alias}, {}, \@pre_order, $collapse);
push(@{$attrs->{select}}, map { $_->[0] } @prefetch);
push(@{$attrs->{as}}, map { $_->[1] } @prefetch);
}
+ push(@{$attrs->{order_by}}, @pre_order);
}
+ $attrs->{collapse} = $collapse;
+# use Data::Dumper; warn Dumper($collapse) if keys %{$collapse};
if ($attrs->{page}) {
$attrs->{rows} ||= 10;
$attrs->{offset} ||= 0;
$attrs->{offset} += ($attrs->{rows} * ($attrs->{page} - 1));
}
- my $new = {
+
+ bless {
result_source => $source,
+ result_class => $attrs->{result_class} || $source->result_class,
cond => $attrs->{where},
from => $attrs->{from},
+ collapse => $collapse,
count => undef,
page => delete $attrs->{page},
pager => undef,
- attrs => $attrs };
- bless ($new, $class);
- return $new;
+ attrs => $attrs
+ }, $class;
}
=head2 search
- my @obj = $rs->search({ foo => 3 }); # "... WHERE foo = 3"
- my $new_rs = $rs->search({ foo => 3 });
+=over 4
+
+=item Arguments: (\%cond?, \%attrs?)
+
+=item Returns: $resultset (scalar context), @row_objs (list context)
+
+=back
+
+ my @cds = $cd_rs->search({ year => 2001 }); # "... WHERE year = 2001"
+ my $new_rs = $cd_rs->search({ year => 2005 });
If you need to pass in additional attributes but no additional condition,
-call it as C<search({}, \%attrs);>.
+call it as C<search(undef, \%attrs);>.
- # "SELECT foo, bar FROM $class_table"
- my @all = $class->search({}, { cols => [qw/foo bar/] });
+ # "SELECT name, artistid FROM $artist_table"
+ my @all_artists = $schema->resultset('Artist')->search(undef, {
+ columns => [qw/name artistid/],
+ });
=cut
sub search {
my $self = shift;
- #use Data::Dumper;warn Dumper(@_);
my $rs;
if( @_ ) {
my $attrs = { %{$self->{attrs}} };
- if (@_ > 1 && ref $_[$#_] eq 'HASH') {
- $attrs = { %$attrs, %{ pop(@_) } };
- }
-
- my $where = (@_ ? ((@_ == 1 || ref $_[0] eq "HASH") ? shift : {@_}) : undef());
+ 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) {
- $where = (defined $attrs->{where}
+ $attrs->{where} = (defined $attrs->{where}
? { '-and' =>
[ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
$where, $attrs->{where} ] }
: $where);
- $attrs->{where} = $where;
+ }
+
+ if (defined $having) {
+ $attrs->{having} = (defined $attrs->{having}
+ ? { '-and' =>
+ [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
+ $having, $attrs->{having} ] }
+ : $having);
}
$rs = (ref $self)->new($self->result_source, $attrs);
}
else {
$rs = $self;
- $rs->reset();
+ $rs->reset;
}
return (wantarray ? $rs->all : $rs);
}
=head2 search_literal
- my @obj = $rs->search_literal($literal_where_cond, @bind);
- my $new_rs = $rs->search_literal($literal_where_cond, @bind);
+=over 4
+
+=item Arguments: ($literal_cond, @bind?)
+
+=item Returns: $resultset (scalar context), @row_objs (list context)
+
+=back
+
+ my @cds = $cd_rs->search_literal('year = ? AND title = ?', qw/2001 Reload/);
+ my $newrs = $artist_rs->search_literal('name = ?', 'Metallica');
Pass a literal chunk of SQL to be added to the conditional part of the
-resultset.
+resultset query.
=cut
-
+
sub search_literal {
my ($self, $cond, @vals) = @_;
my $attrs = (ref $vals[$#vals] eq 'HASH' ? { %{ pop(@vals) } } : {});
=head2 find
-=head3 Arguments: (@colvalues) | (\%cols, \%attrs?)
+=over 4
+
+=item Arguments: (@colvalues) | (\%cols, \%attrs?)
+
+=item Returns: $row_object
+
+=back
Finds a row based on its primary key or unique constraint. For example:
Also takes an optional C<key> attribute, to search by a specific key or unique
constraint. For example:
- my $cd = $schema->resultset('CD')->find_or_create(
+ my $cd = $schema->resultset('CD')->find(
{
artist => 'Massive Attack',
title => 'Mezzanine',
my @cols = $self->result_source->primary_columns;
if (exists $attrs->{key}) {
my %uniq = $self->result_source->unique_constraints;
- $self->( "Unknown key " . $attrs->{key} . " on " . $self->name )
- unless exists $uniq{$attrs->{key}};
+ $self->throw_exception(
+ "Unknown key $attrs->{key} on '" . $self->result_source->name . "'"
+ ) unless exists $uniq{$attrs->{key}};
@cols = @{ $uniq{$attrs->{key}} };
}
#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;
+ $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') {
} else {
$query = {@vals};
}
- foreach (keys %$query) {
- next if m/\./;
- $query->{$self->{attrs}{alias}.'.'.$_} = delete $query->{$_};
+ foreach my $key (grep { ! m/\./ } keys %$query) {
+ $query->{"$self->{attrs}{alias}.$key"} = delete $query->{$key};
}
#warn Dumper($query);
- return (keys %$attrs
- ? $self->search($query,$attrs)->single
- : $self->single($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);
+ }
}
=head2 search_related
- $rs->search_related('relname', $cond?, $attrs?);
+=over 4
+
+=item Arguments: (\%cond?, \%attrs?)
-Search the specified relationship. Optionally specify a condition for matching
-records.
+=item Returns: $new_resultset
+
+=back
+
+ $new_rs = $cd_rs->search_related('artist', {
+ name => 'Emo-R-Us',
+ });
+
+Search the specified relationship, optionally specify a condition and
+attributes for matching records. See L</ATTRIBUTES> for more information.
=cut
=head2 cursor
-Returns a storage-driven cursor to the given resultset.
+=over 4
+
+=item Arguments: (none)
+
+=item Returns: $cursor
+
+=back
+
+Returns a storage-driven cursor to the given resultset. See
+L<DBIx::Class::Cursor> for more information.
=cut
sub cursor {
my ($self) = @_;
- my ($attrs) = $self->{attrs};
- $attrs = { %$attrs };
+ my $attrs = { %{$self->{attrs}} };
return $self->{cursor}
||= $self->result_source->storage->select($self->{from}, $attrs->{select},
$attrs->{where},$attrs);
=head2 single
-Inflates the first result without creating a cursor
+=over 4
+
+=item Arguments: (\%cond)
+
+=item Returns: $row_object
+
+=back
+
+ my $cd = $schema->resultset('CD')->single({ year => 2001 });
+
+Inflates the first result without creating a cursor.
=cut
sub single {
- my ($self, $extra) = @_;
- my ($attrs) = $self->{attrs};
- $attrs = { %$attrs };
- if ($extra) {
+ my ($self, $where) = @_;
+ my $attrs = { %{$self->{attrs}} };
+ if ($where) {
if (defined $attrs->{where}) {
$attrs->{where} = {
- '-and'
- => [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
- delete $attrs->{where}, $extra ]
+ '-and' =>
+ [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
+ $where, delete $attrs->{where} ]
};
} else {
- $attrs->{where} = $extra;
+ $attrs->{where} = $where;
}
}
my @data = $self->result_source->storage->select_single(
=head2 search_like
-Perform a search, but use C<LIKE> instead of equality as the condition. Note
-that this is simply a convenience method; you most likely want to use
+=over 4
+
+=item Arguments: (\%cond?, \%attrs?)
+
+=item Returns: $resultset (scalar context), @row_objs (list context)
+
+=back
+
+ # 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
+that this is simply a convenience method. You most likely want to use
L</search> with specific operators.
For more information, see L<DBIx::Class::Manual::Cookbook>.
=cut
sub search_like {
- my $class = shift;
- my $attrs = { };
- if (@_ > 1 && ref $_[$#_] eq 'HASH') {
- $attrs = pop(@_);
- }
- my $query = ref $_[0] eq "HASH" ? { %{shift()} }: {@_};
+ my $class = shift;
+ my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
+ my $query = ref $_[0] eq 'HASH' ? { %{shift()} }: {@_};
$query->{$_} = { 'like' => $query->{$_} } for keys %$query;
return $class->search($query, { %$attrs });
}
=head2 slice
-=head3 Arguments: ($first, $last)
+=over 4
+
+=item Arguments: ($first, $last)
+
+=item Returns: $resultset (scalar context), @row_objs (list context)
+
+=back
Returns a subset of elements from the resultset.
Can be used to efficiently iterate over records in the resultset:
- my $rs = $schema->resultset('CD')->search({});
+ my $rs = $schema->resultset('CD')->search;
while (my $cd = $rs->next) {
print $cd->title;
}
sub next {
my ($self) = @_;
- my $cache = $self->get_cache;
- if( @$cache ) {
+ if (@{$self->{all_cache} || []}) {
$self->{all_cache_position} ||= 0;
- my $obj = $cache->[$self->{all_cache_position}];
- $self->{all_cache_position}++;
- return $obj;
+ return $self->{all_cache}->[$self->{all_cache_position}++];
+ }
+ if ($self->{attrs}{cache}) {
+ $self->{all_cache_position} = 1;
+ return ($self->all)[0];
}
- my @row = $self->cursor->next;
+ my @row = (exists $self->{stashed_row} ?
+ @{delete $self->{stashed_row}} :
+ $self->cursor->next
+ );
# warn Dumper(\@row); use Data::Dumper;
return unless (@row);
return $self->_construct_object(@row);
sub _construct_object {
my ($self, @row) = @_;
- my @row_orig = @row; # copy @row for key comparison later, because @row will change
my @as = @{ $self->{attrs}{as} };
-#use Data::Dumper; warn Dumper \@as;
- #warn "@cols -> @row";
- my $info = [ {}, {} ];
- foreach my $as (@as) {
- my $rs = $self;
- my $target = $info;
- my @parts = split(/\./, $as);
- my $col = pop(@parts);
- foreach my $p (@parts) {
- $target = $target->[1]->{$p} ||= [];
-
- $rs = $rs->related_resultset($p) if $rs->{attrs}->{cache};
- }
-
- $target->[0]->{$col} = shift @row
- if ref($target->[0]) ne 'ARRAY'; # arrayref is pre-inflated objects, do not overwrite
- }
- #use Data::Dumper; warn Dumper(\@as, $info);
- my $new = $self->result_source->result_class->inflate_result(
- $self->result_source, @$info);
+
+ my $info = $self->_collapse_result(\@as, \@row);
+
+ my $new = $self->result_class->inflate_result($self->result_source, @$info);
+
$new = $self->{attrs}{record_filter}->($new)
if exists $self->{attrs}{record_filter};
-
- if( $self->{attrs}->{cache} ) {
- while( my( $rel, $rs ) = each( %{$self->{related_resultsets}} ) ) {
- $rs->all;
- #warn "$rel:", @{$rs->get_cache};
- }
- $self->build_rr( $self, $new );
- }
-
return $new;
}
-
-sub build_rr {
- # build related resultsets for supplied object
- my ( $self, $context, $obj ) = @_;
-
- my $re = qr/^\w+\./;
- while( my ($rel, $rs) = each( %{$context->{related_resultsets}} ) ) {
- #warn "context:", $context->result_source->name, ", rel:$rel, rs:", $rs->result_source->name;
- my @objs = ();
- my $map = {};
- my $cond = $context->result_source->relationship_info($rel)->{cond};
- keys %$cond;
- while( my( $rel_key, $pk ) = each(%$cond) ) {
- $rel_key =~ s/$re//;
- $pk =~ s/$re//;
- $map->{$rel_key} = $pk;
+
+sub _collapse_result {
+ my ($self, $as, $row, $prefix) = @_;
+
+ my %const;
+
+ my @copy = @$row;
+ foreach my $this_as (@$as) {
+ my $val = shift @copy;
+ if (defined $prefix) {
+ if ($this_as =~ m/^\Q${prefix}.\E(.+)$/) {
+ my $remain = $1;
+ $remain =~ /^(?:(.*)\.)?([^.]+)$/;
+ $const{$1||''}{$2} = $val;
+ }
+ } else {
+ $this_as =~ /^(?:(.*)\.)?([^.]+)$/;
+ $const{$1||''}{$2} = $val;
}
-
- $rs->reset();
- while( my $rel_obj = $rs->next ) {
- while( my( $rel_key, $pk ) = each(%$map) ) {
- if( $rel_obj->get_column($rel_key) eq $obj->get_column($pk) ) {
- push @objs, $rel_obj;
- }
+ }
+
+ my $info = [ {}, {} ];
+ foreach my $key (keys %const) {
+ if (length $key) {
+ my $target = $info;
+ my @parts = split(/\./, $key);
+ foreach my $p (@parts) {
+ $target = $target->[1]->{$p} ||= [];
}
+ $target->[0] = $const{$key};
+ } else {
+ $info->[0] = $const{$key};
}
+ }
- my $rel_rs = $obj->related_resultset($rel);
- $rel_rs->{attrs}->{cache} = 1;
- $rel_rs->set_cache( \@objs );
-
- while( my $rel_obj = $rel_rs->next ) {
- $self->build_rr( $rs, $rel_obj );
+ my @collapse;
+ if (defined $prefix) {
+ @collapse = map {
+ m/^\Q${prefix}.\E(.+)$/ ? ($1) : ()
+ } keys %{$self->{collapse}}
+ } else {
+ @collapse = keys %{$self->{collapse}};
+ };
+
+ if (@collapse) {
+ my ($c) = sort { length $a <=> length $b } @collapse;
+ my $target = $info;
+ foreach my $p (split(/\./, $c)) {
+ $target = $target->[1]->{$p} ||= [];
}
-
+ my $c_prefix = (defined($prefix) ? "${prefix}.${c}" : $c);
+ my @co_key = @{$self->{collapse}{$c_prefix}};
+ my %co_check = map { ($_, $target->[0]->{$_}); } @co_key;
+ my $tree = $self->_collapse_result($as, $row, $c_prefix);
+ my (@final, @raw);
+ while ( !(grep {
+ !defined($tree->[0]->{$_}) ||
+ $co_check{$_} ne $tree->[0]->{$_}
+ } @co_key) ) {
+ push(@final, $tree);
+ last unless (@raw = $self->cursor->next);
+ $row = $self->{stashed_row} = \@raw;
+ $tree = $self->_collapse_result($as, $row, $c_prefix);
+ #warn Data::Dumper::Dumper($tree, $row);
+ }
+ @$target = @final;
}
-
+
+ return $info;
}
=head2 result_source
sub count {
my $self = shift;
- return $self->search(@_)->count if @_ && defined $_[0];
- unless (defined $self->{count}) {
- return scalar @{ $self->get_cache }
- if @{ $self->get_cache };
- my $group_by;
- my $select = { 'count' => '*' };
- if( $group_by = delete $self->{attrs}{group_by} ) {
- my @distinct = (ref $group_by ? @$group_by : ($group_by));
- # todo: try CONCAT for multi-column pk
- my @pk = $self->result_source->primary_columns;
- if( scalar(@pk) == 1 ) {
- my $pk = shift(@pk);
- my $alias = $self->{attrs}{alias};
- my $re = qr/^($alias\.)?$pk$/;
- foreach my $column ( @distinct) {
- if( $column =~ $re ) {
- @distinct = ( $column );
- last;
- }
- }
- }
+ return $self->search(@_)->count if @_ and defined $_[0];
+ return scalar @{ $self->get_cache } if @{ $self->get_cache };
- $select = { count => { 'distinct' => \@distinct } };
- #use Data::Dumper; die Dumper $select;
- }
+ my $count = $self->_count;
+ return 0 unless $count;
- my $attrs = { %{ $self->{attrs} },
- select => $select,
- as => [ 'count' ] };
- # offset, order by and page are not needed to count. record_filter is cdbi
- delete $attrs->{$_} for qw/rows offset order_by page pager record_filter/;
-
- ($self->{count}) = (ref $self)->new($self->result_source, $attrs)->cursor->next;
- $self->{attrs}{group_by} = $group_by;
- }
- return 0 unless $self->{count};
- my $count = $self->{count};
$count -= $self->{attrs}{offset} if $self->{attrs}{offset};
$count = $self->{attrs}{rows} if
- ($self->{attrs}{rows} && $self->{attrs}{rows} < $count);
+ $self->{attrs}{rows} and $self->{attrs}{rows} < $count;
+ return $count;
+}
+
+sub _count { # Separated out so pager can get the full count
+ my $self = shift;
+ my $select = { count => '*' };
+ my $attrs = { %{ $self->{attrs} } };
+ if (my $group_by = delete $attrs->{group_by}) {
+ delete $attrs->{having};
+ my @distinct = (ref $group_by ? @$group_by : ($group_by));
+ # todo: try CONCAT for multi-column pk
+ my @pk = $self->result_source->primary_columns;
+ if (@pk == 1) {
+ foreach my $column (@distinct) {
+ if ($column =~ qr/^(?:\Q$attrs->{alias}.\E)?$pk[0]$/) {
+ @distinct = ($column);
+ last;
+ }
+ }
+ }
+
+ $select = { count => { distinct => \@distinct } };
+ #use Data::Dumper; die Dumper $select;
+ }
+
+ $attrs->{select} = $select;
+ $attrs->{as} = [qw/count/];
+
+ # offset, order by and page are not needed to count. record_filter is cdbi
+ delete $attrs->{$_} for qw/rows offset order_by page pager record_filter/;
+
+ my ($count) = (ref $self)->new($self->result_source, $attrs)->cursor->next;
return $count;
}
=head2 count_literal
-Calls L</search_literal> with the passed arguments, then L</count>.
+Counts the results in a literal query. Equivalent to calling L</search_literal>
+with the passed arguments, then L</count>.
=cut
=head2 all
-Returns all elements in the resultset. Called implictly if the resultset
+Returns all elements in the resultset. Called implicitly if the resultset
is returned in list context.
=cut
sub all {
my ($self) = @_;
- return @{ $self->get_cache }
- if @{ $self->get_cache };
- if( $self->{attrs}->{cache} ) {
- my @obj = map { $self->_construct_object(@$_); }
- $self->cursor->all;
- $self->set_cache( \@obj );
- return @{ $self->get_cache };
+ return @{ $self->get_cache } if @{ $self->get_cache };
+
+ my @obj;
+
+ if (keys %{$self->{collapse}}) {
+ # Using $self->cursor->all is really just an optimisation.
+ # If we're collapsing has_many prefetches it probably makes
+ # very little difference, and this is cleaner than hacking
+ # _construct_object to survive the approach
+ $self->cursor->reset;
+ my @row = $self->cursor->next;
+ while (@row) {
+ push(@obj, $self->_construct_object(@row));
+ @row = (exists $self->{stashed_row}
+ ? @{delete $self->{stashed_row}}
+ : $self->cursor->next);
+ }
+ } else {
+ @obj = map { $self->_construct_object(@$_) } $self->cursor->all;
}
- return map { $self->_construct_object(@$_); }
- $self->cursor->all;
+
+ $self->set_cache(\@obj) if $self->{attrs}{cache};
+ return @obj;
}
=head2 reset
=head2 update
-=head3 Arguments: (\%values)
+=over 4
+
+=item Arguments: (\%values)
+
+=back
Sets the specified columns in the resultset to the supplied values.
sub update {
my ($self, $values) = @_;
- $self->throw_exception("Values for update must be a hash") unless ref $values eq 'HASH';
+ $self->throw_exception("Values for update must be a hash")
+ unless ref $values eq 'HASH';
return $self->result_source->storage->update(
- $self->result_source->from, $values, $self->{cond});
+ $self->result_source->from, $values, $self->{cond}
+ );
}
=head2 update_all
-=head3 Arguments: (\%values)
+=over 4
+
+=item Arguments: (\%values)
+
+=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.
sub update_all {
my ($self, $values) = @_;
- $self->throw_exception("Values for update must be a hash") unless ref $values eq 'HASH';
+ $self->throw_exception("Values for update must be a hash")
+ unless ref $values eq 'HASH';
foreach my $obj ($self->all) {
$obj->set_columns($values)->update;
}
=head2 delete
-Deletes the contents of the resultset from its result source.
+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.
=cut
sub delete {
my ($self) = @_;
my $del = {};
- $self->throw_exception("Can't delete on resultset with condition unless hash or array")
- unless (ref($self->{cond}) eq 'HASH' || ref($self->{cond}) eq 'ARRAY');
- if (ref $self->{cond} eq 'ARRAY') {
+
+ 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 =~ /([^\.]+)$/;
+ $key =~ /([^.]+)$/;
$hash{$1} = $_->{$key};
}; \%hash; } @{$self->{cond}} ];
- } elsif ((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};
+
+ } 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"
+ );
}
+
$self->result_source->storage->delete($self->result_source->from, $del);
return 1;
}
sub pager {
my ($self) = @_;
my $attrs = $self->{attrs};
- $self->throw_exception("Can't create pager for non-paged rs") unless $self->{page};
+ $self->throw_exception("Can't create pager for non-paged rs")
+ unless $self->{page};
$attrs->{rows} ||= 10;
- $self->count;
return $self->{pager} ||= Data::Page->new(
- $self->{count}, $attrs->{rows}, $self->{page});
+ $self->_count, $attrs->{rows}, $self->{page});
}
=head2 page
-=head3 Arguments: ($page_num)
+=over 4
+
+=item Arguments: ($page_num)
+
+=back
Returns a new resultset for the specified page.
=head2 new_result
-=head3 Arguments: (\%vals)
+=over 4
+
+=item Arguments: (\%vals)
+
+=back
Creates a result in the resultset's result class.
my ($self, $values) = @_;
$self->throw_exception( "new_result needs a hash" )
unless (ref $values eq 'HASH');
- $self->throw_exception( "Can't abstract implicit construct, condition not a hash" )
- if ($self->{cond} && !(ref $self->{cond} eq 'HASH'));
+ $self->throw_exception(
+ "Can't abstract implicit construct, condition not a hash"
+ ) if ($self->{cond} && !(ref $self->{cond} eq 'HASH'));
my %new = %$values;
my $alias = $self->{attrs}{alias};
foreach my $key (keys %{$self->{cond}||{}}) {
- $new{$1} = $self->{cond}{$key} if ($key =~ m/^(?:$alias\.)?([^\.]+)$/);
+ $new{$1} = $self->{cond}{$key} if ($key =~ m/^(?:\Q${alias}.\E)?([^.]+)$/);
}
- my $obj = $self->result_source->result_class->new(\%new);
+ my $obj = $self->result_class->new(\%new);
$obj->result_source($self->result_source) if $obj->can('result_source');
- $obj;
+ return $obj;
}
=head2 create
-=head3 Arguments: (\%vals)
+=over 4
+
+=item Arguments: (\%vals)
+
+=back
Inserts a record into the resultset and returns the object.
sub create {
my ($self, $attrs) = @_;
- $self->throw_exception( "create needs a hashref" ) unless ref $attrs eq 'HASH';
+ $self->throw_exception( "create needs a hashref" )
+ unless ref $attrs eq 'HASH';
return $self->new_result($attrs)->insert;
}
=head2 find_or_create
-=head3 Arguments: (\%vals, \%attrs?)
+=over 4
+
+=item Arguments: (\%vals, \%attrs?)
+
+=back
$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.
+Searches for a record matching the search condition; if it doesn't find one,
+creates one and returns that instead.
my $cd = $schema->resultset('CD')->find_or_create({
cdid => 5,
sub find_or_create {
my $self = shift;
my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
- my $hash = ref $_[0] eq "HASH" ? shift : {@_};
+ my $hash = ref $_[0] eq 'HASH' ? shift : {@_};
my $exists = $self->find($hash, $attrs);
- return defined($exists) ? $exists : $self->create($hash);
+ return defined $exists ? $exists : $self->create($hash);
}
=head2 update_or_create
sub update_or_create {
my $self = shift;
-
my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
- my $hash = ref $_[0] eq "HASH" ? shift : {@_};
+ my $hash = ref $_[0] eq 'HASH' ? shift : {@_};
my %unique_constraints = $self->result_source->unique_constraints;
my @constraint_names = (exists $attrs->{key}
if (scalar keys %unique_hash == scalar @unique_cols);
}
- my $row;
if (@unique_hashes) {
- $row = $self->search(\@unique_hashes, { rows => 1 })->first;
- if ($row) {
+ my $row = $self->single(\@unique_hashes);
+ if (defined $row) {
$row->set_columns($hash);
$row->update;
+ return $row;
}
}
- unless ($row) {
- $row = $self->create($hash);
- }
-
- return $row;
+ return $self->create($hash);
}
=head2 get_cache
=cut
sub get_cache {
- my $self = shift;
- return $self->{all_cache} || [];
+ shift->{all_cache} || [];
}
=head2 set_cache
-Sets the contents of the cache for the resultset. Expects an arrayref of objects of the same class as those produced by the resultset.
+Sets the contents of the cache for the resultset. Expects an arrayref
+of objects of the same class as those produced by the resultset.
=cut
my ( $self, $data ) = @_;
$self->throw_exception("set_cache requires an arrayref")
if ref $data ne 'ARRAY';
- my $result_class = $self->result_source->result_class;
+ my $result_class = $self->result_class;
foreach( @$data ) {
- $self->throw_exception("cannot cache object of type '$_', expected '$result_class'")
- if ref $_ ne $result_class;
+ $self->throw_exception(
+ "cannot cache object of type '$_', expected '$result_class'"
+ ) if ref $_ ne $result_class;
}
$self->{all_cache} = $data;
}
=cut
sub clear_cache {
- my $self = shift;
- $self->set_cache([]);
+ shift->set_cache([]);
}
=head2 related_resultset
Returns a related resultset for the supplied relationship name.
- $rs = $rs->related_resultset('foo');
+ $artist_rs = $schema->resultset('CD')->related_resultset('Artist');
=cut
sub related_resultset {
my ( $self, $rel, @rest ) = @_;
$self->{related_resultsets} ||= {};
- my $resultsets = $self->{related_resultsets};
- if( !exists $resultsets->{$rel} ) {
- #warn "fetching related resultset for rel '$rel'";
- my $rel_obj = $self->result_source->relationship_info($rel);
- $self->throw_exception(
- "search_related: result source '" . $self->result_source->name .
- "' has no such relationship ${rel}")
- unless $rel_obj; #die Dumper $self->{attrs};
- my $rs;
- if( $self->{attrs}->{cache} ) {
- $rs = $self->search(undef);
- }
- else {
- $rs = $self->search(undef, { join => $rel });
- }
- #use Data::Dumper; die Dumper $rs->{attrs};#$rs = $self->search( undef );
- #use Data::Dumper; warn Dumper $self->{attrs}, Dumper $rs->{attrs};
- my $alias = (defined $rs->{attrs}{seen_join}{$rel}
- && $rs->{attrs}{seen_join}{$rel} > 1
- ? join('_', $rel, $rs->{attrs}{seen_join}{$rel})
- : $rel);
- $resultsets->{$rel} =
+ return $self->{related_resultsets}{$rel} ||= do {
+ #warn "fetching related resultset for rel '$rel'";
+ my $rel_obj = $self->result_source->relationship_info($rel);
+ $self->throw_exception(
+ "search_related: result source '" . $self->result_source->name .
+ "' has no such relationship ${rel}")
+ unless $rel_obj; #die Dumper $self->{attrs};
+
+ my $rs = $self->search(undef, { join => $rel });
+ my $alias = defined $rs->{attrs}{seen_join}{$rel}
+ && $rs->{attrs}{seen_join}{$rel} > 1
+ ? join('_', $rel, $rs->{attrs}{seen_join}{$rel})
+ : $rel;
+
$self->result_source->schema->resultset($rel_obj->{class}
)->search( undef,
{ %{$rs->{attrs}},
alias => $alias,
- select => undef(),
- as => undef() }
- )->search(@rest);
- }
- return $resultsets->{$rel};
+ select => undef,
+ as => undef }
+ )->search(@rest);
+ };
}
=head2 throw_exception
=head1 ATTRIBUTES
+XXX: FIXME: Attributes docs need clearing up
+
The resultset takes various attributes that modify its behavior. Here's an
overview of them:
=head2 order_by
-Which column(s) to order the results by. This is currently passed through
-directly to SQL, so you can give e.g. C<foo DESC> for a descending order.
+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'.
+
+=head2 columns
-=head2 cols
+=over 4
-=head3 Arguments: (arrayref)
+=item Arguments: (\@columns)
+
+=back
Shortcut to request a particular set of columns to be retrieved. Adds
C<me.> onto the start of any column without a C<.> in it and sets C<select>
-from that, then auto-populates C<as> from C<select> as normal.
+from that, then auto-populates C<as> from C<select> as normal. (You may also
+use the C<cols> attribute, as in earlier versions of DBIC.)
=head2 include_columns
-=head3 Arguments: (arrayref)
+=over 4
+
+=item Arguments: (\@columns)
+
+=back
Shortcut to include additional columns in the returned results - for example
- { include_columns => ['foo.name'], join => ['foo'] }
+ $schema->resultset('CD')->search(undef, {
+ include_columns => ['artist.name'],
+ join => ['artist']
+ });
-would add a 'name' column to the information passed to object inflation
+would return all CDs and include a 'name' column to the information
+passed to object inflation
=head2 select
-=head3 Arguments: (arrayref)
+=over 4
+
+=item Arguments: (\@columns)
+
+=back
Indicates which columns should be selected from the storage. You can use
column names, or in the case of RDBMS back ends, function or stored procedure
names:
- $rs = $schema->resultset('Foo')->search(
- {},
- {
- select => [
- 'column_name',
- { count => 'column_to_count' },
- { sum => 'column_to_sum' }
- ]
- }
- );
+ $rs = $schema->resultset('Employee')->search(undef, {
+ select => [
+ 'name',
+ { count => 'employeeid' },
+ { sum => 'salary' }
+ ]
+ });
When you use function/stored procedure names and do not supply an C<as>
attribute, the column names returned are storage-dependent. E.g. MySQL would
-return a column named C<count(column_to_count)> in the above example.
+return a column named C<count(employeeid)> in the above example.
=head2 as
-=head3 Arguments: (arrayref)
+=over 4
+
+=item Arguments: (\@names)
+
+=back
Indicates column names for object inflation. This is used in conjunction with
C<select>, usually when C<select> contains one or more function or stored
procedure names:
- $rs = $schema->resultset('Foo')->search(
- {},
- {
- select => [
- 'column1',
- { count => 'column2' }
- ],
- as => [qw/ column1 column2_count /]
- }
- );
+ $rs = $schema->resultset('Employee')->search(undef, {
+ select => [
+ 'name',
+ { count => 'employeeid' }
+ ],
+ as => ['name', 'employee_count'],
+ });
- my $foo = $rs->first(); # get the first Foo
+ my $employee = $rs->first(); # get the first Employee
If the object against which the search is performed already has an accessor
matching a column name specified in C<as>, the value can be retrieved using
the accessor as normal:
- my $column1 = $foo->column1();
+ my $name = $employee->name();
If on the other hand an accessor does not exist in the object, you need to
use C<get_column> instead:
- my $column2_count = $foo->get_column('column2_count');
+ my $employee_count = $employee->get_column('employee_count');
You can create your own accessors if required - see
L<DBIx::Class::Manual::Cookbook> for details.
If the same join is supplied twice, it will be aliased to <rel>_2 (and
similarly for a third time). For e.g.
- my $rs = $schema->resultset('Artist')->search(
- { 'cds.title' => 'Foo',
- 'cds_2.title' => 'Bar' },
- { join => [ qw/cds cds/ ] });
+ my $rs = $schema->resultset('Artist')->search({
+ 'cds.title' => 'Down to Earth',
+ 'cds_2.title' => 'Popular',
+ }, {
+ join => [ qw/cds cds/ ],
+ });
-will return a set of all artists that have both a cd with title Foo and a cd
-with title Bar.
+will return a set of all artists that have both a cd with title 'Down
+to Earth' and a cd with title 'Popular'.
If you want to fetch related objects from other tables as well, see C<prefetch>
below.
=head2 prefetch
-=head3 Arguments: arrayref/hashref
+=over 4
+
+=item Arguments: (\@relationships)
+
+=back
Contains one or more relationships that should be fetched along with the main
query (when they are accessed afterwards they will have already been
objects, because it saves at least one query:
my $rs = $schema->resultset('Tag')->search(
- {},
+ undef,
{
prefetch => {
cd => 'artist'
=head2 from
-=head3 Arguments: (arrayref)
+=over 4
+
+=item Arguments: (\@array)
+
+=back
The C<from> attribute gives you manual control over the C<FROM> clause of SQL
statements generated by L<DBIx::Class>, allowing you to express custom C<JOIN>
[
{ <alias> => <table>, -join-type => 'inner|left|right' }
[] # nested JOIN (optional)
- { <table.column> = <foreign_table.foreign_key> }
+ { <table.column> => <foreign_table.foreign_key> }
]
JOIN
then search against all mothers of those children:
$rs = $schema->resultset('Person')->search(
- {},
+ undef,
{
alias => 'mother', # alias columns in accordance with "from"
from => [
]
],
{ 'mother.person_id' => 'child.mother_id' }
- ],
+ ],
]
},
);
with a father in the person table, we could explicitly use C<INNER JOIN>:
$rs = $schema->resultset('Person')->search(
- {},
+ undef,
{
alias => 'child', # alias columns in accordance with "from"
from => [
=head2 page
+=over 4
+
+=item Arguments: ($page)
+
+=back
+
For a paged resultset, specifies which page to retrieve. Leave unset
for an unpaged resultset.
=head2 rows
-For a paged resultset, how many rows per page:
+=over 4
+
+=item Arguments: ($rows)
+
+=back
+
+For a paged resultset, specifies how many rows are in each page:
rows => 10
=head2 group_by
-=head3 Arguments: (arrayref)
+=over 4
+
+=item Arguments: (\@columns)
+
+=back
A arrayref of columns to group by. Can include columns of joined tables.
Set to 1 to group by all columns.
+=head2 cache
+
+Set to 1 to cache search results. This prevents extra SQL queries if you
+revisit rows in your ResultSet:
+
+ my $resultset = $schema->resultset('Artist')->search( undef, { cache => 1 } );
+
+ while( my $artist = $resultset->next ) {
+ ... do stuff ...
+ }
+
+ $rs->first; # without cache, this would issue a query
+
+By default, searches are not cached.
+
For more examples of using these attributes, see
L<DBIx::Class::Manual::Cookbook>.
projects / dbsrgits/DBIx-Class.git / blobdiff