use strict;
use warnings;
-use Carp qw/croak/;
use overload
'0+' => 'count',
'bool' => sub { 1; },
use Data::Page;
use Storable;
+use base qw/DBIx::Class/;
+__PACKAGE__->load_components(qw/AccessorGroup/);
+__PACKAGE__->mk_group_accessors('simple' => 'result_source');
+
=head1 NAME
DBIx::Class::ResultSet - Responsible for fetching and creating resultset.
$attrs->{select} = [ map { m/\./ ? $_ : "${alias}.$_" } @cols ];
}
$attrs->{as} ||= [ map { m/^$alias\.(.*)$/ ? $1 : $_ } @{$attrs->{select}} ];
+ if (my $include = delete $attrs->{include_columns}) {
+ push(@{$attrs->{select}}, @$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} ||= {};
if (my $join = delete $attrs->{join}) {
foreach my $j (ref $join eq 'ARRAY'
? (@{$join}) : ($join)) {
$seen{$j} = 1;
}
}
- push(@{$attrs->{from}}, $source->resolve_join($join, $attrs->{alias}));
+ push(@{$attrs->{from}}, $source->resolve_join($join, $attrs->{alias}, $attrs->{seen_join}));
}
$attrs->{group_by} ||= $attrs->{select} if delete $attrs->{distinct};
- foreach my $pre (@{delete $attrs->{prefetch} || []}) {
- push(@{$attrs->{from}}, $source->resolve_join($pre, $attrs->{alias}))
- unless $seen{$pre};
- my @pre =
- map { "$pre.$_" }
- $source->related_source($pre)->columns;
- push(@{$attrs->{select}}, @pre);
- push(@{$attrs->{as}}, @pre);
+
+ if (my $prefetch = delete $attrs->{prefetch}) {
+ 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 {
+ push(@{$attrs->{from}}, $source->resolve_join($p, $attrs->{alias}))
+ unless $seen{$p};
+ }
+ my @prefetch = $source->resolve_prefetch($p, $attrs->{alias});
+ #die Dumper \@cols;
+ push(@{$attrs->{select}}, map { $_->[0] } @prefetch);
+ push(@{$attrs->{as}}, map { $_->[1] } @prefetch);
+ }
}
+
if ($attrs->{page}) {
$attrs->{rows} ||= 10;
$attrs->{offset} ||= 0;
$attrs->{offset} += ($attrs->{rows} * ($attrs->{page} - 1));
}
my $new = {
- source => $source,
+ result_source => $source,
cond => $attrs->{where},
from => $attrs->{from},
count => undef,
$attrs->{where} = $where;
}
- my $rs = (ref $self)->new($self->{source}, $attrs);
+ my $rs = (ref $self)->new($self->result_source, $attrs);
return (wantarray ? $rs->all : $rs);
}
my ($self, @vals) = @_;
my $attrs = (@vals > 1 && ref $vals[$#vals] eq 'HASH' ? pop(@vals) : {});
- my @cols = $self->{source}->primary_columns;
+ my @cols = $self->result_source->primary_columns;
if (exists $attrs->{key}) {
- my %uniq = $self->{source}->unique_constraints;
+ my %uniq = $self->result_source->unique_constraints;
$self->( "Unknown key " . $attrs->{key} . " on " . $self->name )
unless exists $uniq{$attrs->{key}};
@cols = @{ $uniq{$attrs->{key}} };
}
#use Data::Dumper; warn Dumper($attrs, @vals, @cols);
- $self->{source}->result_class->throw( "Can't find unless a primary key or unique constraint is defined" )
+ $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];
+ $query = { %{$vals[0]} };
} elsif (@cols == @vals) {
$query = {};
@{$query}{@cols} = @vals;
} else {
$query = {@vals};
}
+ foreach (keys %$query) {
+ next if m/\./;
+ $query->{$self->{attrs}{alias}.'.'.$_} = delete $query->{$_};
+ }
#warn Dumper($query);
- # Useless -> disabled
- #$self->{source}->result_class->throw( "Can't find unless all primary keys are specified" )
- # unless (keys %$query >= @pk); # If we check 'em we run afoul of uc/lc
- # column names etc. Not sure what to do yet
- return $self->search($query)->next;
+ return $self->search($query,$attrs)->next;
}
=head2 search_related
sub search_related {
my ($self, $rel, @rest) = @_;
- my $rel_obj = $self->{source}->relationship_info($rel);
- $self->{source}->result_class->throw(
+ my $rel_obj = $self->result_source->relationship_info($rel);
+ $self->throw_exception(
"No such relationship ${rel} in search_related")
unless $rel_obj;
my $rs = $self->search(undef, { join => $rel });
- return $self->{source}->schema->resultset($rel_obj->{class}
+ my $alias = ($rs->{attrs}{seen_join}{$rel} > 1
+ ? join('_', $rel, $rs->{attrs}{seen_join}{$rel})
+ : $rel);
+ return $self->result_source->schema->resultset($rel_obj->{class}
)->search( undef,
{ %{$rs->{attrs}},
- alias => $rel,
+ alias => $alias,
select => undef(),
as => undef() }
)->search(@rest);
sub cursor {
my ($self) = @_;
- my ($source, $attrs) = @{$self}{qw/source attrs/};
+ my ($attrs) = $self->{attrs};
$attrs = { %$attrs };
return $self->{cursor}
- ||= $source->storage->select($self->{from}, $attrs->{select},
+ ||= $self->result_source->storage->select($self->{from}, $attrs->{select},
$attrs->{where},$attrs);
}
$attrs->{offset} ||= 0;
$attrs->{offset} += $min;
$attrs->{rows} = ($max ? ($max - $min + 1) : 1);
- my $slice = (ref $self)->new($self->{source}, $attrs);
+ my $slice = (ref $self)->new($self->result_source, $attrs);
return (wantarray ? $slice->all : $slice);
}
sub _construct_object {
my ($self, @row) = @_;
- my @cols = @{ $self->{attrs}{as} };
+ my @as = @{ $self->{attrs}{as} };
#warn "@cols -> @row";
- my (%me, %pre);
- foreach my $col (@cols) {
- if ($col =~ /([^\.]+)\.([^\.]+)/) {
- $pre{$1}[0]{$2} = shift @row;
- } else {
- $me{$col} = shift @row;
+ my $info = [ {}, {} ];
+ foreach my $as (@as) {
+ my $target = $info;
+ my @parts = split(/\./, $as);
+ my $col = pop(@parts);
+ foreach my $p (@parts) {
+ $target = $target->[1]->{$p} ||= [];
}
+ $target->[0]->{$col} = shift @row;
}
- my $new = $self->{source}->result_class->inflate_result(
- $self->{source}, \%me, \%pre);
+ #use Data::Dumper; warn Dumper(\@as, $info);
+ my $new = $self->result_source->result_class->inflate_result(
+ $self->result_source, @$info);
$new = $self->{attrs}{record_filter}->($new)
if exists $self->{attrs}{record_filter};
return $new;
}
+=head2 result_source
+
+Returns a reference to the result source for this recordset.
+
+=cut
+
+
=head2 count
Performs an SQL C<COUNT> with the same query as the resultset was built
with to find the number of elements. If passed arguments, does a search
on the resultset and counts the results of that.
+Note: When using C<count> with C<group_by>, L<DBIX::Class> emulates C<GROUP BY>
+using C<COUNT( DISTINCT( columns ) )>. Some databases (notably SQLite) do
+not support C<DISTINCT> with multiple columns. If you are using such a
+database, you should only use columns from the main table in your C<group_by>
+clause.
+
=cut
sub count {
my $self = shift;
return $self->search(@_)->count if @_ && defined $_[0];
- croak "Unable to ->count with a GROUP BY" if defined $self->{attrs}{group_by};
unless (defined $self->{count}) {
+ 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 ( @$group_by ) {
+ if( $column =~ $re ) {
+ @distinct = ( $column );
+ last;
+ }
+ }
+ }
+
+ $select = { count => { 'distinct' => \@distinct } };
+ #use Data::Dumper; die Dumper $select;
+ }
+
my $attrs = { %{ $self->{attrs} },
- select => { 'count' => '*' },
+ 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->{source}, $attrs)->cursor->next;
+ ($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};
sub update {
my ($self, $values) = @_;
- croak "Values for update must be a hash" unless ref $values eq 'HASH';
- return $self->{source}->storage->update(
- $self->{source}->from, $values, $self->{cond});
+ $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});
}
=head2 update_all(\%values)
sub update_all {
my ($self, $values) = @_;
- croak "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;
}
sub delete {
my ($self) = @_;
- $self->{source}->storage->delete($self->{source}->from, $self->{cond});
+ 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') {
+ $del = [ map { my %hash;
+ foreach my $key (keys %{$_}) {
+ $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};
+ }
+ }
+ $self->result_source->storage->delete($self->result_source->from, $del);
return 1;
}
sub pager {
my ($self) = @_;
my $attrs = $self->{attrs};
- croak "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(
my ($self, $page) = @_;
my $attrs = { %{$self->{attrs}} };
$attrs->{page} = $page;
- return (ref $self)->new($self->{source}, $attrs);
+ return (ref $self)->new($self->result_source, $attrs);
}
=head2 new_result(\%vals)
sub new_result {
my ($self, $values) = @_;
- $self->{source}->result_class->throw( "new_result needs a hash" )
+ $self->throw_exception( "new_result needs a hash" )
unless (ref $values eq 'HASH');
- $self->{source}->result_class->throw( "Can't abstract implicit construct, condition not a 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\.)?([^\.]+)$/);
}
- my $obj = $self->{source}->result_class->new(\%new);
- $obj->result_source($self->{source}) if $obj->can('result_source');
+ my $obj = $self->result_source->result_class->new(\%new);
+ $obj->result_source($self->result_source) if $obj->can('result_source');
$obj;
}
sub create {
my ($self, $attrs) = @_;
- $self->{source}->result_class->throw( "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;
}
my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
my $hash = ref $_[0] eq "HASH" ? shift : {@_};
- my %unique_constraints = $self->{source}->unique_constraints;
+ my %unique_constraints = $self->result_source->unique_constraints;
my @constraint_names = (exists $attrs->{key}
? ($attrs->{key})
: keys %unique_constraints);
return $row;
}
+=head2 throw_exception
+
+See Schema's throw_exception
+
+=cut
+
+sub throw_exception {
+ my $self=shift;
+ $self->result_source->schema->throw_exception(@_);
+}
+
=head1 ATTRIBUTES
The resultset takes various attributes that modify its behavior. Here's an
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.
+=head2 include_columns (arrayref)
+
+Shortcut to include additional columns in the returned results - for example
+
+ { include_columns => ['foo.name'], join => ['foo'] }
+
+would add a 'name' column to the information passed to object inflation
+
=head2 select (arrayref)
Indicates which columns should be selected from the storage. You can use
}
);
-If you want to fetch the columns from the related table as well, see
-C<prefetch> below.
+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/ ] });
+
+will return a set of all artists that have both a cd with title Foo and a cd
+with title Bar.
+
+If you want to fetch related objects from other tables as well, see C<prefetch>
+below.
-=head2 prefetch
+=head2 prefetch arrayref/hashref
-Contains a list of 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 a query. Currently limited to prefetching
-one relationship deep, so unlike C<join>, prefetch must be an arrayref.
+objects, because it saves at least one query:
+
+ my $rs = $schema->resultset('Tag')->search(
+ {},
+ {
+ prefetch => {
+ cd => 'artist'
+ }
+ }
+ );
+
+The initial search results in SQL like the following:
+
+ SELECT tag.*, cd.*, artist.* FROM tag
+ JOIN cd ON tag.cd = cd.cdid
+ JOIN artist ON cd.artist = artist.artistid
+
+L<DBIx::Class> has no need to go back to the database when we access the
+C<cd> or C<artist> relationships, which saves us two SQL statements in this
+case.
+
+Simple prefetches will be joined automatically, so there is no need
+for a C<join> attribute in the above search. If you're prefetching to
+depth (e.g. { cd => { artist => 'label' } or similar), you'll need to
+specify the join as well.
+
+C<prefetch> can be used with the following relationship types: C<belongs_to>,
+C<has_one> (or if you're using C<add_relationship>, any relationship declared
+with an accessor type of 'single' or 'filter').
=head2 from (arrayref)
=head2 group_by (arrayref)
-A arrayref of columns to group by. Can include columns of joined tables. Note
-note that L</count> doesn't work on grouped resultsets.
+A arrayref of columns to group by. Can include columns of joined tables.
group_by => [qw/ column1 column2 ... /]
projects / dbsrgits/DBIx-Class.git / blobdiff