use DBIx::Class::ResultSetColumn;
use Scalar::Util qw/blessed weaken/;
use Try::Tiny;
+use Data::Compare (); # no imports!!! guard against insane architecture
# not importing first() as it will clash with our own method
use List::Util ();
sub get_data {
my $self = shift;
my $request = $self->get_request; # Get a request object somehow.
- my $schema = $self->get_schema; # Get the DBIC schema object somehow.
+ my $schema = $self->result_source->schema;
my $cd_rs = $schema->resultset('CD')->search({
title => $request->param('title'),
attrs => $attrs,
}, $class;
+ # if there is a dark selector, this means we are already in a
+ # chain and the cleanup/sanification was taken care of by
+ # _search_rs already
+ $self->_normalize_selection($attrs)
+ unless $attrs->{_dark_selector};
+
$self->result_class(
$attrs->{result_class} || $source->result_class
);
=item Arguments: $cond, \%attrs?
-=item Return Value: $resultset (scalar context), @row_objs (list context)
+=item Return Value: $resultset (scalar context) || @row_objs (list context)
=back
my $new_rs = $cd_rs->search([ { year => 2005 }, { year => 2004 } ]);
# year = 2005 OR year = 2004
+In list context, C<< ->all() >> is called implicitly on the resultset, thus
+returning a list of row objects instead. To avoid that, use L</search_rs>.
+
If you need to pass in additional attributes but no additional condition,
call it as C<search(undef, \%attrs)>.
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>. For a complete
-documentation for the first argument, see L<SQL::Abstract>.
+documentation for the first argument, see L<SQL::Abstract>
+and its extension L<DBIx::Class::SQLMaker>.
For more help on using joins with search, see L<DBIx::Class::Manual::Joining>.
# take care of call attrs (only if anything is changing)
if (keys %$call_attrs) {
- $self->throw_exception ('_trailing_select is not a public attribute - do not use it in search()')
- if ( exists $call_attrs->{_trailing_select} or exists $call_attrs->{'+_trailing_select'} );
+ my @selector_attrs = qw/select as columns cols +select +as +columns include_columns/;
- my @selector_attrs = qw/select as columns cols +select +as +columns include_columns _trailing_select +_trailing_select/;
+ # reset the current selector list if new selectors are supplied
+ if (List::Util::first { exists $call_attrs->{$_} } qw/columns cols select as/) {
+ delete @{$old_attrs}{(@selector_attrs, '_dark_selector')};
+ }
- # Normalize the selector list (operates on the passed-in attr structure)
+ # Normalize the new selector list (operates on the passed-in attr structure)
# Need to do it on every chain instead of only once on _resolved_attrs, in
- # order to separate 'as'-ed from blind 'select's
+ # order to allow detection of empty vs partial 'as'
+ $call_attrs->{_dark_selector} = $old_attrs->{_dark_selector}
+ if $old_attrs->{_dark_selector};
$self->_normalize_selection ($call_attrs);
# start with blind overwriting merge, exclude selector attrs
$new_attrs = { %{$old_attrs}, %{$call_attrs} };
delete @{$new_attrs}{@selector_attrs};
- # reset the current selector list if new selectors are supplied
- if (List::Util::first { exists $call_attrs->{$_} } qw/columns cols select as/) {
- delete @{$old_attrs}{@selector_attrs};
- }
-
for (@selector_attrs) {
$new_attrs->{$_} = $self->_merge_attr($old_attrs->{$_}, $call_attrs->{$_})
if ( exists $old_attrs->{$_} or exists $call_attrs->{$_} );
return $rs;
}
+my $dark_sel_dumper;
sub _normalize_selection {
my ($self, $attrs) = @_;
$attrs->{'+columns'} = $self->_merge_attr($attrs->{'+columns'}, delete $attrs->{include_columns})
if exists $attrs->{include_columns};
+ # columns are always placed first, however
+
# Keep the X vs +X separation until _resolved_attrs time - this allows to
# delay the decision on whether to use a default select list ($rsrc->columns)
# allowing stuff like the remove_columns helper to work
# supplied at all) - try to infer the alias, either from the -as parameter
# of the selector spec, or use the parameter whole if it looks like a column
# name (ugly legacy heuristic). If all fails - leave the selector bare (which
- # is ok as well), but transport it over a separate attribute to make sure it is
- # the last thing in the select list, thus unable to throw off the corresponding
- # 'as' chain
+ # is ok as well), but make sure no more additions to the 'as' chain take place
for my $pref ('', '+') {
my ($sel, $as) = map {
);
}
elsif( ! @$as ) {
- # no as part supplied at all - try to deduce
+ # no as part supplied at all - try to deduce (unless explicit end of named selection is declared)
# if any @$as has been supplied we assume the user knows what (s)he is doing
# and blindly keep stacking up pieces
- my (@new_sel, @new_trailing);
- for (@$sel) {
- if ( ref $_ eq 'HASH' and exists $_->{-as} ) {
- push @$as, $_->{-as};
- push @new_sel, $_;
- }
- # assume any plain no-space, no-parenthesis string to be a column spec
- # FIXME - this is retarded but is necessary to support shit like 'count(foo)'
- elsif ( ! ref $_ and $_ =~ /^ [^\s\(\)]+ $/x) {
- push @$as, $_;
- push @new_sel, $_;
- }
- # if all else fails - shove the selection to the trailing stack and move on
- else {
- push @new_trailing, $_;
+ unless ($attrs->{_dark_selector}) {
+ SELECTOR:
+ for (@$sel) {
+ if ( ref $_ eq 'HASH' and exists $_->{-as} ) {
+ push @$as, $_->{-as};
+ }
+ # assume any plain no-space, no-parenthesis string to be a column spec
+ # FIXME - this is retarded but is necessary to support shit like 'count(foo)'
+ elsif ( ! ref $_ and $_ =~ /^ [^\s\(\)]+ $/x) {
+ push @$as, $_;
+ }
+ # if all else fails - raise a flag that no more aliasing will be allowed
+ else {
+ $attrs->{_dark_selector} = {
+ plus_stage => $pref,
+ string => ($dark_sel_dumper ||= do {
+ require Data::Dumper::Concise;
+ Data::Dumper::Concise::DumperObject()->Indent(0);
+ })->Values([$_])->Dump
+ ,
+ };
+ last SELECTOR;
+ }
}
}
-
- @$sel = @new_sel;
- $attrs->{"${pref}_trailing_select"} = $self->_merge_attr($attrs->{"${pref}_trailing_select"}, \@new_trailing)
- if @new_trailing;
}
elsif (@$as < @$sel) {
$self->throw_exception(
"Unable to handle an ${pref}as specification (@$as) with less elements than the corresponding ${pref}select"
);
}
-
- # now see what the result for this pair looks like:
- if (@$as == @$sel) {
-
- # if balanced - treat as a columns entry
- $attrs->{"${pref}columns"} = $self->_merge_attr(
- $attrs->{"${pref}columns"},
- [ map { +{ $as->[$_] => $sel->[$_] } } ( 0 .. $#$as ) ]
+ elsif ($pref and $attrs->{_dark_selector}) {
+ $self->throw_exception(
+ "Unable to process named '+select', resultset contains an unnamed selector $attrs->{_dark_selector}{string}"
);
}
- else {
- # unbalanced - shove in select/as, not subject to deduplication in _resolved_attrs
- $attrs->{"${pref}select"} = $self->_merge_attr($attrs->{"${pref}select"}, $sel);
- $attrs->{"${pref}as"} = $self->_merge_attr($attrs->{"${pref}as"}, $as);
- }
- }
+
+ # merge result
+ $attrs->{"${pref}select"} = $self->_merge_attr($attrs->{"${pref}select"}, $sel);
+ $attrs->{"${pref}as"} = $self->_merge_attr($attrs->{"${pref}as"}, $as);
+ }
}
sub _stack_cond {
my ($self, $left, $right) = @_;
+
+ # collapse single element top-level conditions
+ # (single pass only, unlikely to need recursion)
+ for ($left, $right) {
+ if (ref $_ eq 'ARRAY') {
+ if (@$_ == 0) {
+ $_ = undef;
+ }
+ elsif (@$_ == 1) {
+ $_ = $_->[0];
+ }
+ }
+ elsif (ref $_ eq 'HASH') {
+ my ($first, $more) = keys %$_;
+
+ # empty hash
+ if (! defined $first) {
+ $_ = undef;
+ }
+ # one element hash
+ elsif (! defined $more) {
+ if ($first eq '-and' and ref $_->{'-and'} eq 'HASH') {
+ $_ = $_->{'-and'};
+ }
+ elsif ($first eq '-or' and ref $_->{'-or'} eq 'ARRAY') {
+ $_ = $_->{'-or'};
+ }
+ }
+ }
+ }
+
+ # merge hashes with weeding out of duplicates (simple cases only)
+ if (ref $left eq 'HASH' and ref $right eq 'HASH') {
+
+ # shallow copy to destroy
+ $right = { %$right };
+ for (grep { exists $right->{$_} } keys %$left) {
+ # the use of eq_deeply here is justified - the rhs of an
+ # expression can contain a lot of twisted weird stuff
+ delete $right->{$_} if Data::Compare::Compare( $left->{$_}, $right->{$_} );
+ }
+
+ $right = undef unless keys %$right;
+ }
+
+
if (defined $left xor defined $right) {
return defined $left ? $left : $right;
}
- elsif (defined $left) {
- return { -and => [ map
- { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
- ($left, $right)
- ]};
+ elsif (! defined $left) {
+ return undef;
+ }
+ else {
+ return { -and => [ $left, $right ] };
}
-
- return undef;
}
=head2 search_literal
=item Arguments: $sql_fragment, @bind_values
-=item Return Value: $resultset (scalar context), @row_objs (list context)
+=item Return Value: $resultset (scalar context) || @row_objs (list context)
=back
my $rsrc = $self->result_source;
+ my $constraint_name;
+ if (exists $attrs->{key}) {
+ $constraint_name = defined $attrs->{key}
+ ? $attrs->{key}
+ : $self->throw_exception("An undefined 'key' resultset attribute makes no sense")
+ ;
+ }
+
# Parse out the condition from input
my $call_cond;
+
if (ref $_[0] eq 'HASH') {
$call_cond = { %{$_[0]} };
}
else {
- my $constraint = exists $attrs->{key} ? $attrs->{key} : 'primary';
- my @c_cols = $rsrc->unique_constraint_columns($constraint);
+ # if only values are supplied we need to default to 'primary'
+ $constraint_name = 'primary' unless defined $constraint_name;
+
+ my @c_cols = $rsrc->unique_constraint_columns($constraint_name);
$self->throw_exception(
- "No constraint columns, maybe a malformed '$constraint' constraint?"
+ "No constraint columns, maybe a malformed '$constraint_name' constraint?"
) unless @c_cols;
$self->throw_exception (
'find() expects either a column/value hashref, or a list of values '
- . "corresponding to the columns of the specified unique constraint '$constraint'"
+ . "corresponding to the columns of the specified unique constraint '$constraint_name'"
) unless @c_cols == @_;
$call_cond = {};
my $alias = exists $attrs->{alias} ? $attrs->{alias} : $self->{attrs}{alias};
my $final_cond;
- if (exists $attrs->{key}) {
+ if (defined $constraint_name) {
$final_cond = $self->_qualify_cond_columns (
$self->_build_unique_cond (
- $attrs->{key},
+ $constraint_name,
$call_cond,
),
=item Arguments: $rel, $cond, \%attrs?
-=item Return Value: $new_resultset
+=item Return Value: $new_resultset (scalar context) || @row_objs (list context)
=back
Searches the specified relationship, optionally specifying a condition and
attributes for matching records. See L</ATTRIBUTES> for more information.
+In list context, C<< ->all() >> is called implicitly on the resultset, thus
+returning a list of row objects instead. To avoid that, use L</search_related_rs>.
+
+See also L</search_related_rs>.
+
=cut
sub search_related {
=item Arguments: $cond, \%attrs?
-=item Return Value: $resultset (scalar context), @row_objs (list context)
+=item Return Value: $resultset (scalar context) || @row_objs (list context)
=back
=item Arguments: $first, $last
-=item Return Value: $resultset (scalar context), @row_objs (list context)
+=item Return Value: $resultset (scalar context) || @row_objs (list context)
=back
# overwrite the selector (supplied by the storage)
$tmp_attrs->{select} = $rsrc->storage->_count_select ($rsrc, $attrs);
$tmp_attrs->{as} = 'count';
- delete @{$tmp_attrs}{qw/columns _trailing_select/};
+ delete @{$tmp_attrs}{qw/columns/};
my $tmp_rs = $rsrc->resultset_class->new($rsrc, $tmp_attrs)->get_column ('count');
my $sub_attrs = { %$attrs };
# extra selectors do not go in the subquery and there is no point of ordering it, nor locking it
- delete @{$sub_attrs}{qw/collapse columns as select _prefetch_selector_range _trailing_select order_by for/};
+ delete @{$sub_attrs}{qw/collapse columns as select _prefetch_selector_range order_by for/};
# if we multi-prefetch we group_by primary keys only as this is what we would
# get out of the rs via ->next/->all. We *DO WANT* to clobber old group_by regardless
=back
-Returns all elements in the resultset. Called implicitly if the resultset
-is returned in list context.
+Returns all elements in the resultset.
=cut
my $rsrc = $self->result_source;
- # if a condition exists we need to strip all table qualifiers
- # if this is not possible we'll force a subquery below
- my $cond = $rsrc->schema->storage->_strip_cond_qualifiers ($self->{cond});
-
my $needs_group_by_subq = $self->_has_resolved_attr (qw/collapse group_by -join/);
- my $needs_subq = $needs_group_by_subq || (not defined $cond) || $self->_has_resolved_attr(qw/rows offset/);
+ my $needs_subq = $needs_group_by_subq || $self->_has_resolved_attr(qw/rows offset/);
if ($needs_group_by_subq or $needs_subq) {
return $self->result_source->storage->_subq_update_delete($subrs, $op, $values);
}
else {
+ # Most databases do not allow aliasing of tables in UPDATE/DELETE. Thus
+ # a condition containing 'me' or other table prefixes will not work
+ # at all. What this code tries to do (badly) is to generate a condition
+ # with the qualifiers removed, by exploiting the quote mechanism of sqla
+ #
+ # this is atrocious and should be replaced by normal sqla introspection
+ # one sunny day
+ my ($sql, @bind) = do {
+ my $sqla = $rsrc->storage->sql_maker;
+ local $sqla->{_dequalify_idents} = 1;
+ $sqla->_recurse_where($self->{cond});
+ } if $self->{cond};
+
return $rsrc->storage->$op(
$rsrc,
$op eq 'update' ? $values : (),
- $cond,
+ $self->{cond} ? \[$sql, @bind] : (),
);
}
}
unless ref $values eq 'HASH';
my $guard = $self->result_source->schema->txn_scope_guard;
- $_->update($values) for $self->all;
+ $_->update({%$values}) for $self->all; # shallow copy - update will mangle it
$guard->commit;
return 1;
}
# cruft placed in standalone method
my $data = $self->_normalize_populate_args(@_);
+ return unless @$data;
+
if(defined wantarray) {
my @created;
foreach my $item (@$data) {
my ($self, $arg) = @_;
if (ref $arg eq 'ARRAY') {
- if (ref $arg->[0] eq 'HASH') {
+ if (!@$arg) {
+ return [];
+ }
+ elsif (ref $arg->[0] eq 'HASH') {
return $arg;
}
elsif (ref $arg->[0] eq 'ARRAY') {
return $self->{pager} if $self->{pager};
- if ($self->get_cache) {
- $self->throw_exception ('Pagers on cached resultsets are not supported');
- }
-
my $attrs = $self->{attrs};
if (!defined $attrs->{page}) {
$self->throw_exception("Can't create pager for non-paged rs");
my $source = $self->result_source;
my $alias = $attrs->{alias};
- # one last pass of normalization
- $self->_normalize_selection($attrs);
-
# default selection list
$attrs->{columns} = [ $source->columns ]
- unless List::Util::first { exists $attrs->{$_} } qw/columns cols select as _trailing_select/;
+ unless List::Util::first { exists $attrs->{$_} } qw/columns cols select as/;
# merge selectors together
- for (qw/columns select as _trailing_select/) {
- $attrs->{$_} = $self->_merge_attr($attrs->{$_}, $attrs->{"+$_"})
+ for (qw/columns select as/) {
+ $attrs->{$_} = $self->_merge_attr($attrs->{$_}, delete $attrs->{"+$_"})
if $attrs->{$_} or $attrs->{"+$_"};
}
}
else {
# distinct affects only the main selection part, not what prefetch may
- # add below. However trailing is not yet a part of the selection as
- # prefetch must insert before it
+ # add below.
$attrs->{group_by} = $source->storage->_group_over_selection (
$attrs->{from},
- [ @{$attrs->{select}||[]}, @{$attrs->{_trailing_select}||[]} ],
+ $attrs->{select},
$attrs->{order_by},
);
}
$attrs->{collapse} ||= {};
if ($attrs->{prefetch}) {
+
+ $self->throw_exception("Unable to prefetch, resultset contains an unnamed selector $attrs->{_dark_selector}{string}")
+ if $attrs->{_dark_selector};
+
my $prefetch = $self->_merge_joinpref_attr( {}, delete $attrs->{prefetch} );
my $prefetch_ordering = [];
}
- push @{ $attrs->{select} }, @{$attrs->{_trailing_select}}
- if $attrs->{_trailing_select};
-
# if both page and offset are specified, produce a combined offset
# even though it doesn't make much sense, this is what pre 081xx has
# been doing