use Storable;
use DBIx::Class::ResultSetColumn;
use base qw/DBIx::Class/;
+
__PACKAGE__->load_components(qw/AccessorGroup/);
__PACKAGE__->mk_group_accessors('simple' => qw/result_source result_class/);
}
$attrs->{alias} ||= 'me';
- $attrs->{_orig_alias} ||= $attrs->{alias};
- bless {
+ # XXXX
+ # Use a named hash here and bless afterwards to avoid a huge performance hit
+ # in perl 5.8.8-5+ FC5 and later, and possibly other distributions.
+ #
+ # See https://bugzilla.redhat.com/bugzilla/show_bug.cgi?id=196836 for more
+ # information.
+ my $self = {
result_source => $source,
result_class => $attrs->{result_class} || $source->result_class,
cond => $attrs->{where},
-# from => $attrs->{from},
-# collapse => $collapse,
count => undef,
pager => undef,
attrs => $attrs
- }, $class;
+ };
+
+ bless $self, $class;
+
+ return $self;
}
=head2 search
columns => [qw/name artistid/],
});
+For a list of attributes that can be passed to C<search>, see L</ATTRIBUTES>. For more examples of using this function, see L<Searching|DBIx::Class::Manual::Cookbook/Searching>.
+
=cut
sub search {
sub search_rs {
my $self = shift;
+ my $rows;
+
+ unless (@_) { # no search, effectively just a clone
+ $rows = $self->get_cache;
+ }
+
my $attrs = {};
$attrs = pop(@_) if @_ > 1 and ref $_[$#_] eq 'HASH';
- my $our_attrs = exists $attrs->{_parent_attrs}
- ? { %{delete $attrs->{_parent_attrs}} }
- : { %{$self->{attrs}} };
+ my $our_attrs = { %{$self->{attrs}} };
my $having = delete $our_attrs->{having};
- # XXX should only maintain _live_join_stack and generate _live_join_h from that
- if ($attrs->{_live_join_stack}) {
- 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 (my $live_join = $attrs->{_live_join_stack} || $our_attrs->{_live_join_stack}) {
- foreach my $join (reverse @{$live_join}) {
- $attrs->{$key} = { $join => $attrs->{$key} };
- }
- }
-
$our_attrs->{$key} = $self->_merge_attr($our_attrs->{$key}, delete $attrs->{$key});
}
-
- $our_attrs->{join} = $self->_merge_attr(
- $our_attrs->{join}, $attrs->{_live_join_h}
- ) if ($attrs->{_live_join_h});
-
- if (defined $our_attrs->{prefetch}) {
- $our_attrs->{join} = $self->_merge_attr(
- $our_attrs->{join}, $our_attrs->{prefetch}
- );
- }
-
+
my $new_attrs = { %{$our_attrs}, %{$attrs} };
my $where = (@_
? (
}
my $rs = (ref $self)->new($self->result_source, $new_attrs);
- $rs->{_parent_source} = $self->{_parent_source} if $self->{_parent_source};
-
- unless (@_) { # no search, effectively just a clone
- my $rows = $self->get_cache;
- if ($rows) {
- $rs->set_cache($rows);
- }
+ if ($rows) {
+ $rs->set_cache($rows);
}
return $rs;
}
sub _unique_queries {
my ($self, $query, $attrs) = @_;
+ my $alias = $self->{attrs}{alias};
my @constraint_names = exists $attrs->{key}
? ($attrs->{key})
: $self->result_source->unique_constraint_names;
my @unique_cols = $self->result_source->unique_constraint_columns($name);
my $unique_query = $self->_build_unique_query($query, \@unique_cols);
- next unless scalar keys %$unique_query;
+ my $num_query = scalar keys %$unique_query;
+ next unless $num_query;
# Add the ResultSet's alias
- my $alias = $self->{attrs}{alias};
- foreach my $key (grep { ! m/\./ } keys %$unique_query) {
- $unique_query->{"$alias.$key"} = delete $unique_query->{$key};
+ foreach my $col (grep { ! m/\./ } keys %$unique_query) {
+ $unique_query->{"$alias.$col"} = delete $unique_query->{$col};
}
- push @unique_queries, $unique_query;
+ # XXX: Assuming quite a bit about $self->{attrs}{where}
+ my $num_cols = scalar @unique_cols;
+ my $num_where = exists $self->{attrs}{where}
+ ? scalar keys %{ $self->{attrs}{where} }
+ : 0;
+ push @unique_queries, $unique_query
+ if $num_query + $num_where == $num_cols;
}
return @unique_queries;
}
}
- unless ($self->_is_unique_query($attrs->{where})) {
- carp "Query not guaranteed to return a single row"
- . "; please declare your unique constraints or use search instead";
- }
+# XXX: Disabled since it doesn't infer uniqueness in all cases
+# unless ($self->_is_unique_query($attrs->{where})) {
+# carp "Query not guaranteed to return a single row"
+# . "; please declare your unique constraints or use search instead";
+# }
my @data = $self->result_source->storage->select_single(
$attrs->{from}, $attrs->{select},
foreach my $key (keys %$collapsed) {
my $aliased = $key =~ /\./ ? $key : "$alias.$key";
next unless exists $seen{$aliased}; # Additional constraints are okay
- $seen{$aliased} = scalar @{ $collapsed->{$key} };
+ $seen{$aliased} = scalar keys %{ $collapsed->{$key} };
}
# If we get 0 or more than 1 value for a column, it's not necessarily unique
}
else {
# warn "LEAF: " . Dumper $query;
- foreach my $key (keys %$query) {
- push @{$collapsed->{$key}}, $query->{$key};
+ foreach my $col (keys %$query) {
+ my $value = $query->{$col};
+ $collapsed->{$col}{$value}++;
}
}
}
return $self->_construct_object(@row);
}
-sub _resolved_attrs {
- my $self = shift;
- return $self->{_attrs} if $self->{_attrs};
-
- my $attrs = $self->{attrs};
- my $source = $self->{_parent_source} || $self->{result_source};
- my $alias = $attrs->{_orig_alias};
-
- # XXX - lose storable dclone
- my $record_filter = delete $attrs->{record_filter};
- $attrs = Storable::dclone($attrs || {}); # { %{ $attrs || {} } };
- $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}}
- ];
- $attrs->{as} ||= [
- map { m/^\Q${alias}.\E(.+)$/ ? $1 : $_ } @{$attrs->{select}}
- ];
-
- 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 } ];
- $attrs->{seen_join} ||= {};
- my %seen;
- if (my $join = delete $attrs->{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, $alias, $attrs->{seen_join})
- );
- }
-
- $attrs->{group_by} ||= $attrs->{select} if delete $attrs->{distinct};
- 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, $alias))
- unless $seen{$key};
- }
- } else {
- 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};
- if ($p) {
- my @prefetch = $self->result_source->resolve_prefetch(
- $p, $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;
-
- return $self->{_attrs} = $attrs;
-}
-
-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}) {
- $a->{$key} = $self->_merge_attr($a->{$key}, $b->{$key});
- } else {
- $a->{$key} = $b->{$key};
- }
- }
- return $a;
- } else {
- $a = [$a] unless ref $a eq 'ARRAY';
- $b = [$b] unless ref $b eq 'ARRAY';
-
- my $hash = {};
- 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') {
- push(@array, @{$element});
- } else {
- push(@array, $element) unless $b == $x
- && grep { $_ eq $element } @array;
- }
- }
- }
-
- @array = grep { !exists $hash->{$_} } @array;
-
- return keys %{$hash}
- ? ( scalar(@array)
- ? [$hash, @array]
- : $hash
- )
- : \@array;
- }
-}
-
-# bring the joins (which are from the original class) to the level
-# of the current class so that we can resolve them properly
-sub _reduce_joins {
- my ($self, $p, $attrs) = @_;
-
- STACK:
- foreach my $join (@{$attrs->{_live_join_stack}}) {
- if (ref $p eq 'HASH') {
- return undef unless exists $p->{$join};
- $p = $p->{$join};
- } elsif (ref $p eq 'ARRAY') {
- foreach my $pe (@{$p}) {
- return undef if $pe eq $join;
- if (ref $pe eq 'HASH' && exists $pe->{$join}) {
- $p = $pe->{$join};
- next STACK;
- }
- }
- return undef;
- } else {
- return undef;
- }
- }
- return $p;
-}
-
sub _construct_object {
my ($self, @row) = @_;
my $info = $self->_collapse_result($self->{_attrs}{as}, \@row);
An accessor for the primary ResultSource object from which this ResultSet
is derived.
+=head2 result_class
+
+=over 4
+
+=item Arguments: $result_class?
+
+=item Return Value: $result_class
+
+=back
+
+An accessor for the class to use when creating row objects. Defaults to
+C<< result_source->result_class >> - which in most cases is the name of the
+L<"table"|DBIx::Class::Manual::Glossary/"ResultSource"> class.
+
=cut
# todo: try CONCAT for multi-column pk
my @pk = $self->result_source->primary_columns;
if (@pk == 1) {
- my $alias = $attrs->{_orig_alias};
+ my $alias = $attrs->{alias};
foreach my $column (@distinct) {
if ($column =~ qr/^(?:\Q${alias}.\E)?$pk[0]$/) {
@distinct = ($column);
# 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_source} = $self->{_parent_source} if $self->{_parent_source};
- #XXX - hack to pass through parent of related resultsets
+ my $tmp_rs = (ref $self)->new($self->result_source, $attrs);
my ($count) = $tmp_rs->cursor->next;
return $count;
}
"Can't abstract implicit construct, condition not a hash"
) if ($self->{cond} && !(ref $self->{cond} eq 'HASH'));
my %new = %$values;
- my $alias = $self->{attrs}{_orig_alias};
+ my $alias = $self->{attrs}{alias};
foreach my $key (keys %{$self->{cond}||{}}) {
$new{$1} = $self->{cond}{$key} if ($key =~ m/^(?:\Q${alias}.\E)?([^.]+)$/);
}
"search_related: result source '" . $self->result_source->name .
"' has no such relationship $rel")
unless $rel_obj;
+
+ my ($from,$seen) = $self->_resolve_from($rel);
- my @live_join_stack = @{$self->{attrs}{_live_join_stack}||[]};
-
- # XXX mst: I'm sure this is wrong, somehow
- # something with complex joins early on could die on search_rel
- # followed by a prefetch. I think. need a test case.
-
- my $join_count = scalar(grep { $_ eq $rel } @live_join_stack);
- my $alias = $join_count ? join('_', $rel, $join_count+1) : $rel;
-
- push(@live_join_stack, $rel);
+ my $join_count = $seen->{$rel};
+ my $alias = ($join_count > 1 ? join('_', $rel, $join_count) : $rel);
- my $rs = $self->result_source->schema->resultset($rel_obj->{class})->search(
+ $self->result_source->schema->resultset($rel_obj->{class})->search_rs(
undef, {
+ %{$self->{attrs}||{}},
+ join => undef,
+ prefetch => undef,
select => undef,
as => undef,
alias => $alias,
- _live_join_stack => \@live_join_stack,
- _parent_attrs => $self->{attrs}}
+ where => $self->{cond},
+ seen_join => $seen,
+ from => $from,
+ });
+ };
+}
+
+sub _resolve_from {
+ my ($self, $extra_join) = @_;
+ my $source = $self->result_source;
+ my $attrs = $self->{attrs};
+
+ my $from = $attrs->{from}
+ || [ { $attrs->{alias} => $source->from } ];
+
+ my $seen = { %{$attrs->{seen_join}||{}} };
+
+ my $join = ($attrs->{join}
+ ? [ $attrs->{join}, $extra_join ]
+ : $extra_join);
+ $from = [
+ @$from,
+ ($join ? $source->resolve_join($join, $attrs->{alias}, $seen) : ()),
+ ];
+
+ return ($from,$seen);
+}
+
+sub _resolved_attrs {
+ my $self = shift;
+ return $self->{_attrs} if $self->{_attrs};
+
+ my $attrs = { %{$self->{attrs}||{}} };
+ my $source = $self->{result_source};
+ my $alias = $attrs->{alias};
+
+ $attrs->{columns} ||= delete $attrs->{cols} if exists $attrs->{cols};
+ if ($attrs->{columns}) {
+ delete $attrs->{as};
+ } elsif (!$attrs->{select}) {
+ $attrs->{columns} = [ $source->columns ];
+ }
+
+ $attrs->{select} =
+ ($attrs->{select}
+ ? (ref $attrs->{select} eq 'ARRAY'
+ ? [ @{$attrs->{select}} ]
+ : [ $attrs->{select} ])
+ : [ map { m/\./ ? $_ : "${alias}.$_" } @{delete $attrs->{columns}} ]
);
+ $attrs->{as} =
+ ($attrs->{as}
+ ? (ref $attrs->{as} eq 'ARRAY'
+ ? [ @{$attrs->{as}} ]
+ : [ $attrs->{as} ])
+ : [ map { m/^\Q${alias}.\E(.+)$/ ? $1 : $_ } @{$attrs->{select}} ]
+ );
+
+ 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);
+ }
- # keep reference of the original resultset
- $rs->{_parent_source} = $self->{_parent_source} || $self->result_source;
+ $attrs->{from} ||= [ { 'me' => $source->from } ];
- return $rs;
- };
+ if (exists $attrs->{join} || exists $attrs->{prefetch}) {
+ my $join = delete $attrs->{join} || {};
+
+ if (defined $attrs->{prefetch}) {
+ $join = $self->_merge_attr(
+ $join, $attrs->{prefetch}
+ );
+ }
+
+ $attrs->{from} = # have to copy here to avoid corrupting the original
+ [
+ @{$attrs->{from}},
+ $source->resolve_join($join, $alias, { %{$attrs->{seen_join}||{}} })
+ ];
+ }
+
+ $attrs->{group_by} ||= $attrs->{select} if delete $attrs->{distinct};
+ if ($attrs->{order_by}) {
+ $attrs->{order_by} = (ref($attrs->{order_by}) eq 'ARRAY'
+ ? [ @{$attrs->{order_by}} ]
+ : [ $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)) {
+ # bring joins back to level of current class
+ my @prefetch = $source->resolve_prefetch(
+ $p, $alias, { %{$attrs->{seen_join}||{}} }, \@pre_order, $collapse
+ );
+ push(@{$attrs->{select}}, map { $_->[0] } @prefetch);
+ push(@{$attrs->{as}}, map { $_->[1] } @prefetch);
+ }
+ push(@{$attrs->{order_by}}, @pre_order);
+ }
+ $attrs->{collapse} = $collapse;
+
+ return $self->{_attrs} = $attrs;
+}
+
+sub _merge_attr {
+ my ($self, $a, $b) = @_;
+ return $b unless defined($a);
+ return $a unless defined($b);
+
+ if (ref $b eq 'HASH' && ref $a eq 'HASH') {
+ foreach my $key (keys %{$b}) {
+ if (exists $a->{$key}) {
+ $a->{$key} = $self->_merge_attr($a->{$key}, $b->{$key});
+ } else {
+ $a->{$key} = $b->{$key};
+ }
+ }
+ return $a;
+ } else {
+ $a = [$a] unless ref $a eq 'ARRAY';
+ $b = [$b] unless ref $b eq 'ARRAY';
+
+ my $hash = {};
+ 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') {
+ push(@array, @{$element});
+ } else {
+ push(@array, $element) unless $b == $x
+ && grep { $_ eq $element } @array;
+ }
+ }
+ }
+
+ @array = grep { !exists $hash->{$_} } @array;
+
+ return keys %{$hash}
+ ? ( scalar(@array)
+ ? [$hash, @array]
+ : $hash
+ )
+ : \@array;
+ }
}
=head2 throw_exception
You can create your own accessors if required - see
L<DBIx::Class::Manual::Cookbook> for details.
-Please note: This will NOT insert an C<AS employee_count> into the SQL statement
-produced, it is used for internal access only. Thus attempting to use the accessor
-in an C<order_by> clause or similar will fail misrably.
+Please note: This will NOT insert an C<AS employee_count> into the SQL
+statement produced, it is used for internal access only. Thus
+attempting to use the accessor in an C<order_by> clause or similar
+will fail miserably.
+
+To get around this limitation, you can supply literal SQL to your
+C<select> attibute that contains the C<AS alias> text, eg:
+
+ select => [\'myfield AS alias']
=head2 join