use Carp::Clan qw/^DBIx::Class/;
use Data::Page;
use Storable;
-use Data::Dumper;
use Scalar::Util qw/weaken/;
-use Data::Dumper;
use DBIx::Class::ResultSetColumn;
use base qw/DBIx::Class/;
__PACKAGE__->load_components(qw/AccessorGroup/);
sub new {
my $class = shift;
return $class->new_result(@_) if ref $class;
-
+
my ($source, $attrs) = @_;
weaken $source;
}
$attrs->{alias} ||= 'me';
+ $attrs->{_orig_alias} ||= $attrs->{alias};
bless {
result_source => $source,
# from => $attrs->{from},
# collapse => $collapse,
count => undef,
- page => delete $attrs->{page},
pager => undef,
attrs => $attrs
}, $class;
=back
-This method does the same exact thing as search() except it will
+This method does the same exact thing as search() except it will
always return a resultset, even in list context.
=cut
my $attrs = {};
$attrs = pop(@_) if @_ > 1 and ref $_[$#_] eq 'HASH';
- my $our_attrs = ($attrs->{_parent_attrs})
- ? { %{$attrs->{_parent_attrs}} }
- : { %{$self->{attrs}} };
- delete($attrs->{_parent_attrs}) if(exists $attrs->{_parent_attrs});
+ my $our_attrs = exists $attrs->{_parent_attrs}
+ ? { %{delete $attrs->{_parent_attrs}} }
+ : { %{$self->{attrs}} };
my $having = delete $our_attrs->{having};
- # XXX should only maintain _live_join_stack and generate _live_join_h from that
+ # XXX should only maintain _live_join_stack and generate _live_join_h from that
if ($attrs->{_live_join_stack}) {
- my $live_join = $attrs->{_live_join_stack};
- foreach (reverse @{$live_join}) {
- $attrs->{_live_join_h} = (defined $attrs->{_live_join_h}) ? { $_ => $attrs->{_live_join_h} } : $_;
+ foreach my $join (reverse @{$attrs->{_live_join_stack}}) {
+ $attrs->{_live_join_h} = defined $attrs->{_live_join_h}
+ ? { $join => $attrs->{_live_join_h} }
+ : $join;
}
}
# merge new attrs into inherited
foreach my $key (qw/join prefetch/) {
- next unless (exists $attrs->{$key});
- if ($attrs->{_live_join_stack} || $our_attrs->{_live_join_stack}) {
- my $live_join = $attrs->{_live_join_stack} ||
- $our_attrs->{_live_join_stack};
- foreach (reverse @{$live_join}) {
- $attrs->{$key} = { $_ => $attrs->{$key} };
+ next unless exists $attrs->{$key};
+ if (my $live_join = $attrs->{_live_join_stack} || $our_attrs->{_live_join_stack}) {
+ foreach my $join (reverse @{$live_join}) {
+ $attrs->{$key} = { $join => $attrs->{$key} };
}
}
- if (exists $our_attrs->{$key}) {
- $our_attrs->{$key} = $self->_merge_attr($our_attrs->{$key}, $attrs->{$key});
- } else {
- $our_attrs->{$key} = $attrs->{$key};
- }
- delete $attrs->{$key};
+ $our_attrs->{$key} = $self->_merge_attr($our_attrs->{$key}, delete $attrs->{$key});
}
$our_attrs->{join} = $self->_merge_attr(
? $self->throw_exception("Odd number of arguments to search")
: {@_}
)
- )
- : undef()
+ )
+ : undef
);
if (defined $where) {
}
my $rs = (ref $self)->new($self->result_source, $new_attrs);
- $rs->{_parent_rs} = $self->{_parent_rs} if ($self->{_parent_rs});
+ $rs->{_parent_rs} = $self->{_parent_rs} if $self->{_parent_rs};
unless (@_) { # no search, effectively just a clone
my $rows = $self->get_cache;
# Run the query
if (keys %$attrs) {
my $rs = $self->search($query, $attrs);
- $rs->_resolve;
- return keys %{$rs->{_attrs}->{collapse}} ? $rs->next : $rs->single;
+ $rs->_resolve_attr;
+ return keys %{$rs->{_attrs}{collapse}} ? $rs->next : $rs->single;
}
else {
- $self->_resolve;
- return (keys %{$self->{_attrs}->{collapse}})
+ $self->_resolve_attr;
+ return keys %{$self->{_attrs}{collapse}}
? $self->search($query)->next
: $self->single($query);
}
next unless scalar keys %$unique_query;
# Add the ResultSet's alias
+ my $alias = $self->{attrs}{alias};
foreach my $key (grep { ! m/\./ } keys %$unique_query) {
- my $alias = ($self->{attrs}->{_live_join})
- ? $self->{attrs}->{_live_join}
- : $self->{attrs}->{alias};
$unique_query->{"$alias.$key"} = delete $unique_query->{$key};
}
sub _build_unique_query {
my ($self, $query, $unique_cols) = @_;
- my %unique_query =
+ return {
map { $_ => $query->{$_} }
grep { exists $query->{$_} }
- @$unique_cols;
-
- return \%unique_query;
+ @$unique_cols
+ };
}
=head2 search_related
sub cursor {
my ($self) = @_;
- $self->_resolve;
+ $self->_resolve_attr;
my $attrs = { %{$self->{_attrs}} };
return $self->{cursor}
||= $self->result_source->storage->select($attrs->{from}, $attrs->{select},
sub single {
my ($self, $where) = @_;
- $self->_resolve;
+ $self->_resolve_attr;
my $attrs = { %{$self->{_attrs}} };
if ($where) {
if (defined $attrs->{where}) {
my @data = $self->result_source->storage->select_single(
$attrs->{from}, $attrs->{select},
- $attrs->{where},$attrs
+ $attrs->{where}, $attrs
);
return (@data ? $self->_construct_object(@data) : ());
my ($self, $query) = @_;
my $collapsed = $self->_collapse_query($query);
- my $alias = ($self->{attrs}->{_live_join})
- ? $self->{attrs}->{_live_join}
- : $self->{attrs}->{alias};
+ my $alias = $self->{attrs}{alias};
foreach my $name ($self->result_source->unique_constraint_names) {
my @unique_cols = map {
my %seen = map { $_ => 0 } @unique_cols;
foreach my $key (keys %$collapsed) {
- my $aliased = $key;
- $aliased = "$alias.$key" unless $key =~ /\./;
-
+ my $aliased = $key =~ /\./ ? $key : "$alias.$key";
next unless exists $seen{$aliased}; # Additional constraints are okay
$seen{$aliased} = scalar @{ $collapsed->{$key} };
}
print $cd->title;
}
-Note that you need to store the resultset object, and call C<next> on it.
+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.
return $self->_construct_object(@row);
}
-sub _resolve {
+sub _resolve_attr {
my $self = shift;
+ return if exists $self->{_attrs}; #return if _resolve_attr has already been called
- return if(exists $self->{_attrs}); #return if _resolve has already been called
-
- my $attrs = $self->{attrs};
- my $source = ($self->{_parent_rs})
- ? $self->{_parent_rs}
- : $self->{result_source};
+ my $attrs = $self->{attrs};
+ my $source = $self->{_parent_rs} || $self->{result_source};
+ my $alias = $attrs->{_orig_alias};
# XXX - lose storable dclone
- my $record_filter = delete $attrs->{record_filter}
- if (defined $attrs->{record_filter});
+ my $record_filter = delete $attrs->{record_filter};
$attrs = Storable::dclone($attrs || {}); # { %{ $attrs || {} } };
- $attrs->{record_filter} = $record_filter if ($record_filter);
- $self->{attrs}->{record_filter} = $record_filter if ($record_filter);
-
- my $alias = $attrs->{alias};
-
- $attrs->{columns} ||= delete $attrs->{cols} if $attrs->{cols};
- delete $attrs->{as} if $attrs->{columns};
- $attrs->{columns} ||= [ $self->{result_source}->columns ]
- unless $attrs->{select};
- my $select_alias = ($self->{_parent_rs})
- ? $self->{attrs}->{_live_join}
- : $alias;
- $attrs->{select} = [
+ $attrs->{record_filter} = $record_filter if $record_filter;
+
+ $attrs->{columns} ||= delete $attrs->{cols} if exists $attrs->{cols};
+ if ($attrs->{columns}) {
+ delete $attrs->{as};
+ } elsif (!$attrs->{select}) {
+ $attrs->{columns} = [ $self->{result_source}->columns ];
+ }
+
+ my $select_alias = $self->{attrs}{alias};
+ $attrs->{select} ||= [
map { m/\./ ? $_ : "${select_alias}.$_" } @{delete $attrs->{columns}}
- ] if $attrs->{columns};
+ ];
$attrs->{as} ||= [
- map { m/^\Q$alias.\E(.+)$/ ? $1 : $_ } @{$attrs->{select}}
+ 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);
+
+ my $adds;
+ if ($adds = delete $attrs->{include_columns}) {
+ $adds = [$adds] unless ref $adds eq 'ARRAY';
+ push(@{$attrs->{select}}, @$adds);
+ push(@{$attrs->{as}}, map { m/([^.]+)$/; $1 } @$adds);
+ }
+ if ($adds = delete $attrs->{'+select'}) {
+ $adds = [$adds] unless ref $adds eq 'ARRAY';
+ push(@{$attrs->{select}}, map { /\./ || ref $_ ? $_ : "${alias}.$_" } @$adds);
+ }
+ if (my $adds = delete $attrs->{'+as'}) {
+ $adds = [$adds] unless ref $adds eq 'ARRAY';
+ push(@{$attrs->{as}}, @$adds);
}
$attrs->{from} ||= [ { $alias => $source->from } ];
}
}
push(@{$attrs->{from}},
- $source->resolve_join($join, $attrs->{alias}, $attrs->{seen_join})
+ $source->resolve_join($join, $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} ||= [];
-
- if(my $seladds = delete($attrs->{'+select'})) {
- my @seladds = (ref($seladds) eq 'ARRAY' ? @$seladds : ($seladds));
- $attrs->{select} = [
- @{ $attrs->{select} },
- map { (m/\./ || ref($_)) ? $_ : "${alias}.$_" } $seladds
- ];
- }
- if(my $asadds = delete($attrs->{'+as'})) {
- my @asadds = (ref($asadds) eq 'ARRAY' ? @$asadds : ($asadds));
- $attrs->{as} = [ @{ $attrs->{as} }, @asadds ];
+ if ($attrs->{order_by}) {
+ $attrs->{order_by} = [ $attrs->{order_by} ] unless ref $attrs->{order_by};
+ } else {
+ $attrs->{order_by} ||= [];
}
+
my $collapse = $attrs->{collapse} || {};
if (my $prefetch = delete $attrs->{prefetch}) {
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}))
+ push(@{$attrs->{from}}, $source->resolve_join($p, $alias))
unless $seen{$key};
}
} else {
- push(@{$attrs->{from}}, $source->resolve_join($p, $attrs->{alias}))
+ push(@{$attrs->{from}}, $source->resolve_join($p, $alias))
unless $seen{$p};
}
# bring joins back to level of current class
- $p = $self->_reduce_joins($p, $attrs) if ($attrs->{_live_join_stack});
+ $p = $self->_reduce_joins($p, $attrs) if $attrs->{_live_join_stack};
if ($p) {
my @prefetch = $self->result_source->resolve_prefetch(
- $p, $attrs->{alias}, {}, \@pre_order, $collapse
+ $p, $alias, {}, \@pre_order, $collapse
);
push(@{$attrs->{select}}, map { $_->[0] } @prefetch);
push(@{$attrs->{as}}, map { $_->[1] } @prefetch);
sub _merge_attr {
my ($self, $a, $b) = @_;
-
return $b unless $a;
+
if (ref $b eq 'HASH' && ref $a eq 'HASH') {
foreach my $key (keys %{$b}) {
if (exists $a->{$key}) {
}
return $a;
} else {
- $a = [$a] unless (ref $a eq 'ARRAY');
- $b = [$b] unless (ref $b eq 'ARRAY');
-
+ $a = [$a] unless ref $a eq 'ARRAY';
+ $b = [$b] unless ref $b eq 'ARRAY';
+
my $hash = {};
- my $array = [];
- foreach ($a, $b) {
- foreach my $element (@{$_}) {
+ my @array;
+ foreach my $x ($a, $b) {
+ foreach my $element (@{$x}) {
if (ref $element eq 'HASH') {
$hash = $self->_merge_attr($hash, $element);
} elsif (ref $element eq 'ARRAY') {
- $array = [@{$array}, @{$element}];
- } else {
- if ($b == $_) {
- $self->_merge_array($array, $element);
- } else {
- push(@{$array}, $element);
- }
+ push(@array, @{$element});
+ } else {
+ push(@array, $element) unless $b == $x
+ && grep { $_ eq $element } @array;
}
}
}
+
+ @array = grep { !exists $hash->{$_} } @array;
- my $final_array = [];
- foreach my $element (@{$array}) {
- push(@{$final_array}, $element) unless (exists $hash->{$element});
- }
- $array = $final_array;
-
- if ((keys %{$hash}) && (scalar(@{$array} > 0))) {
- return [$hash, @{$array}];
- } else {
- return (keys %{$hash}) ? $hash : $array;
- }
- }
-}
-
-sub _merge_array {
- my ($self, $a, $b) = @_;
-
- $b = [$b] unless (ref $b eq 'ARRAY');
- # add elements from @{$b} to @{$a} which aren't already in @{$a}
- foreach my $b_element (@{$b}) {
- push(@{$a}, $b_element) unless grep {$b_element eq $_} @{$a};
+ return keys %{$hash}
+ ? ( scalar(@array)
+ ? [$hash, @array]
+ : $hash
+ )
+ : \@array;
}
}
sub _reduce_joins {
my ($self, $p, $attrs) = @_;
- STACK:
- foreach (@{$attrs->{_live_join_stack}}) {
+ STACK:
+ foreach my $join (@{$attrs->{_live_join_stack}}) {
if (ref $p eq 'HASH') {
- if (exists $p->{$_}) {
- $p = $p->{$_};
- } else {
- return undef;
- }
+ return undef unless exists $p->{$join};
+ $p = $p->{$join};
} elsif (ref $p eq 'ARRAY') {
foreach my $pe (@{$p}) {
- if ($pe eq $_) {
- return undef;
- }
- if ((ref $pe eq 'HASH') && (exists $pe->{$_})) {
- $p = $pe->{$_};
+ return undef if $pe eq $join;
+ if (ref $pe eq 'HASH' && exists $pe->{$join}) {
+ $p = $pe->{$join};
next STACK;
}
- }
+ }
return undef;
} else {
return undef;
sub _construct_object {
my ($self, @row) = @_;
- my @as = @{ $self->{_attrs}{as} };
-
- my $info = $self->_collapse_result(\@as, \@row);
+ my $info = $self->_collapse_result($self->{_attrs}{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};
sub _collapse_result {
my ($self, $as, $row, $prefix) = @_;
- my $live_join = $self->{attrs}->{_live_join} ||="";
my %const;
-
my @copy = @$row;
+
foreach my $this_as (@$as) {
my $val = shift @copy;
if (defined $prefix) {
}
}
+ my $alias = $self->{attrs}{alias};
my $info = [ {}, {} ];
foreach my $key (keys %const) {
- if (length $key && $key ne $live_join) {
+ if (length $key && $key ne $alias) {
my $target = $info;
my @parts = split(/\./, $key);
foreach my $p (@parts) {
$info->[0] = $const{$key};
}
}
+
my @collapse;
-
if (defined $prefix) {
@collapse = map {
m/^\Q${prefix}.\E(.+)$/ ? ($1) : ()
- } keys %{$self->{_attrs}->{collapse}}
+ } keys %{$self->{_attrs}{collapse}}
} else {
- @collapse = keys %{$self->{_attrs}->{collapse}};
+ @collapse = keys %{$self->{_attrs}{collapse}};
};
if (@collapse) {
$target = $target->[1]->{$p} ||= [];
}
my $c_prefix = (defined($prefix) ? "${prefix}.${c}" : $c);
- my @co_key = @{$self->{_attrs}->{collapse}{$c_prefix}};
+ my @co_key = @{$self->{_attrs}{collapse}{$c_prefix}};
my $tree = $self->_collapse_result($as, $row, $c_prefix);
my %co_check = map { ($_, $tree->[0]->{$_}); } @co_key;
my (@final, @raw);
$row = $self->{stashed_row} = \@raw;
$tree = $self->_collapse_result($as, $row, $c_prefix);
}
- @$target = (@final ? @final : [ {}, {} ]);
+ @$target = (@final ? @final : [ {}, {} ]);
# single empty result to indicate an empty prefetched has_many
}
sub _count { # Separated out so pager can get the full count
my $self = shift;
my $select = { count => '*' };
-
- $self->_resolve;
+
+ $self->_resolve_attr;
my $attrs = { %{ $self->{_attrs} } };
if (my $group_by = delete $attrs->{group_by}) {
delete $attrs->{having};
# todo: try CONCAT for multi-column pk
my @pk = $self->result_source->primary_columns;
if (@pk == 1) {
+ my $alias = $attrs->{_orig_alias};
foreach my $column (@distinct) {
- if ($column =~ qr/^(?:\Q$attrs->{alias}.\E)?$pk[0]$/) {
+ if ($column =~ qr/^(?:\Q${alias}.\E)?$pk[0]$/) {
@distinct = ($column);
last;
}
# 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 $tmp_rs = (ref $self)->new($self->result_source, $attrs);
- $tmp_rs->{_parent_rs} = $self->{_parent_rs} if ($self->{_parent_rs});
- #XXX - hack to pass through parent of related resultsets
+ my $tmp_rs = (ref $self)->new($self->result_source, $attrs);
+ $tmp_rs->{_parent_rs} = $self->{_parent_rs} if $self->{_parent_rs};
+ #XXX - hack to pass through parent of related resultsets
my ($count) = $tmp_rs->cursor->next;
return $count;
my @obj;
# TODO: don't call resolve here
- $self->_resolve;
- if (keys %{$self->{_attrs}->{collapse}}) {
-# if ($self->{attrs}->{prefetch}) {
+ $self->_resolve_attr;
+ if (keys %{$self->{_attrs}{collapse}}) {
+# if ($self->{attrs}{prefetch}) {
# 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
sub reset {
my ($self) = @_;
- delete $self->{_attrs} if (exists $self->{_attrs});
-
+ delete $self->{_attrs} if exists $self->{_attrs};
$self->{all_cache_position} = 0;
$self->cursor->reset;
return $self;
my ($self) = @_;
my $cond = {};
- if (!ref($self->{cond})) {
- # No-op. No condition, we're updating/deleting everything
- }
- elsif (ref $self->{cond} eq 'ARRAY') {
+ # No-op. No condition, we're updating/deleting everything
+ return $cond unless ref $self->{cond};
+
+ if (ref $self->{cond} eq 'ARRAY') {
$cond = [
map {
my %hash;
$cond->{-and} = [];
my @cond = @{$self->{cond}{-and}};
- for (my $i = 0; $i <= @cond - 1; $i++) {
+ for (my $i = 0; $i < @cond; $i++) {
my $entry = $cond[$i];
my %hash;
sub delete {
my ($self) = @_;
- my $del = {};
my $cond = $self->_cond_for_update_delete;
my ($self) = @_;
my $attrs = $self->{attrs};
$self->throw_exception("Can't create pager for non-paged rs")
- unless $self->{page};
+ unless $self->{attrs}{page};
$attrs->{rows} ||= 10;
return $self->{pager} ||= Data::Page->new(
- $self->_count, $attrs->{rows}, $self->{page});
+ $self->_count, $attrs->{rows}, $self->{attrs}{page});
}
=head2 page
sub page {
my ($self, $page) = @_;
- my $attrs = { %{$self->{attrs}} };
- $attrs->{page} = $page;
- return (ref $self)->new($self->result_source, $attrs);
+ return (ref $self)->new($self->result_source, { %{$self->{attrs}}, page => $page });
}
=head2 new_result
"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};
+ my $alias = $self->{attrs}{_orig_alias};
foreach my $key (keys %{$self->{cond}||{}}) {
$new{$1} = $self->{cond}{$key} if ($key =~ m/^(?:\Q${alias}.\E)?([^.]+)$/);
}
=cut
sub related_resultset {
- my ( $self, $rel ) = @_;
-
+ my ($self, $rel) = @_;
+
$self->{related_resultsets} ||= {};
return $self->{related_resultsets}{$rel} ||= do {
- #warn "fetching related resultset for rel '$rel' " . $self->result_source->{name};
my $rel_obj = $self->result_source->relationship_info($rel);
- #print Dumper($self->result_source->_relationships);
+
$self->throw_exception(
"search_related: result source '" . $self->result_source->name .
- "' has no such relationship ${rel}")
- unless $rel_obj; #die Dumper $self->{attrs};
+ "' has no such relationship $rel")
+ unless $rel_obj;
- my @live_join_stack = (
- exists $self->{attrs}->{_live_join_stack})
- ? @{$self->{attrs}->{_live_join_stack}}
- : ();
+ my @live_join_stack = (@{$self->{attrs}{_live_join_stack}||[]}, $rel);
- push(@live_join_stack, $rel);
-
my $rs = $self->result_source->schema->resultset($rel_obj->{class})->search(
undef, {
select => undef,
as => undef,
- _live_join => $rel, #the most recent
+ alias => $rel, #the most recent
_live_join_stack => \@live_join_stack, #the trail of rels
_parent_attrs => $self->{attrs}}
- );
+ );
# keep reference of the original resultset
- $rs->{_parent_rs} = ($self->{_parent_rs})
- ? $self->{_parent_rs}
- : $self->result_source;
+ $rs->{_parent_rs} = $self->{_parent_rs} || $self->result_source;
return $rs;
};
through directly to SQL, so you can give e.g. C<year DESC> for a
descending order on the column `year'.
-Please note that if you have quoting enabled (see
+Please note that if you have quoting enabled (see
L<DBIx::Class::Storage/quote_char>) you will need to do C<\'year DESC' > to
specify an order. (The scalar ref causes it to be passed as raw sql to the DB,
so you will need to manually quote things as appropriate.)
Makes the resultset paged and specifies the page to retrieve. Effectively
identical to creating a non-pages resultset and then calling ->page($page)
-on it.
+on it.
If L<rows> attribute is not specified it defualts to 10 rows per page.
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.
+done.
having => { 'count(employee)' => { '>=', 100 } }
revisit rows in your ResultSet:
my $resultset = $schema->resultset('Artist')->search( undef, { cache => 1 } );
-
+
while( my $artist = $resultset->next ) {
... do stuff ...
}