X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSet.pm;h=91a5932b0d68d02eadb5b887244b8fb5bf7da353;hb=a14cff9712c23c5761aa570176b9325e611c4360;hp=146c12bbbba8b4fc4c66e6a621f5c0c926ed11e0;hpb=3334d204fcbbddedd73a7f63a285bdda9cb3e031;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index 146c12b..91a5932 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -8,8 +8,9 @@ use DBIx::Class::ResultSetColumn; use Scalar::Util qw/blessed weaken reftype/; use DBIx::Class::_Util 'fail_on_internal_wantarray'; use Try::Tiny; -use Data::Compare (); # no imports!!! guard against insane architecture - +use Data::Dumper::Concise (); +use Data::Query::Constants; +use Data::Query::ExprHelpers; # not importing first() as it will clash with our own method use List::Util (); @@ -397,6 +398,10 @@ sub search_rs { $call_cond = { @_ }; } + if (blessed($call_cond) and $call_cond->isa('Data::Query::ExprBuilder')) { + $call_cond = \$call_cond->{expr}; + } + # see if we can keep the cache (no $rs changes) my $cache; my %safe = (alias => 1, cache => 1); @@ -585,60 +590,23 @@ sub _normalize_selection { 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 %$_; + my $source = $self->result_source; - # 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'}; - } - } - } - } + my $converter = $source->schema->storage->sql_maker->converter; - # merge hashes with weeding out of duplicates (simple cases only) - if (ref $left eq 'HASH' and ref $right eq 'HASH') { + my @top = map $source->_extract_top_level_conditions( + $converter->_expr_to_dq($_) + ), grep defined, $left, $right; - # 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->{$_} ); - } + return undef unless @top; - $right = undef unless keys %$right; - } + my %seen; + my @uniq = grep { !$seen{Data::Dumper::Concise::Dumper($_)}++ } @top; - if (defined $left xor defined $right) { - return defined $left ? $left : $right; - } - elsif (! defined $left) { - return undef; - } - else { - return { -and => [ $left, $right ] }; - } + return \$uniq[0] if @uniq == 1; + + return \Operator({ 'SQL.Naive' => 'AND' }, \@uniq); } =head2 search_literal @@ -1358,7 +1326,7 @@ sub _construct_results { if ( $aliastypes->{multiplying}{$sel_alias} or - scalar grep { $aliastypes->{multiplying}{(values %$_)[0]} } @{ $aliastypes->{selecting}{$sel_alias}{-parents} } + $aliastypes->{premultiplied}{$sel_alias} ) { $multiplied_selectors->{$_} = 1 for values %{$aliastypes->{selecting}{$sel_alias}{-seen_columns}} } @@ -1728,15 +1696,20 @@ sub _count_subq_rs { $sql_maker->{name_sep} = ''; } + # delete local is 5.12+ + local @{$sql_maker}{qw(renderer converter)}; + delete @{$sql_maker}{qw(renderer converter)}; + my ($lquote, $rquote, $sep) = map { quotemeta $_ } ($sql_maker->_quote_chars, $sql_maker->name_sep); - my $having_sql = $sql_maker->_parse_rs_attrs ({ having => $attrs->{having} }); + my $having_sql = $sql_maker->_render_sqla(where => $attrs->{having}); + my %seen_having; # search for both a proper quoted qualified string, for a naive unquoted scalarref # and if all fails for an utterly naive quoted scalar-with-function while ($having_sql =~ / - $rquote $sep $lquote (.+?) $rquote + (?: $rquote $sep)? $lquote (.+?) $rquote | [\s,] \w+ \. (\w+) [\s,] | @@ -1908,7 +1881,7 @@ sub _rs_update_delete { if (!$needs_subq and @{$attrs->{from}} > 1) { ($attrs->{from}, $join_classifications) = - $storage->_prune_unused_joins ($attrs->{from}, $attrs->{select}, $self->{cond}, $attrs); + $storage->_prune_unused_joins ($attrs); # any non-pruneable non-local restricting joins imply subq $needs_subq = defined List::Util::first { $_ ne $attrs->{alias} } keys %{ $join_classifications->{restricting} || {} }; @@ -1926,12 +1899,18 @@ sub _rs_update_delete { if (! $needs_subq) { # 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. Tell SQLMaker to dequalify idents via a gross hack. - $cond = do { - my $sqla = $rsrc->storage->sql_maker; - local $sqla->{_dequalify_idents} = 1; - \[ $sqla->_recurse_where($self->{cond}) ]; - }; + # at all - so we convert the WHERE to a dq tree now, dequalify all + # identifiers found therein via a scan across the tree, and then use + # \{} style to pass the result onwards for use in the final query + if ($self->{cond}) { + $cond = do { + my $converter = $rsrc->storage->sql_maker->converter; + scan_dq_nodes({ + DQ_IDENTIFIER ,=> sub { $_ = [ $_->[-1] ] for $_[0]->{elements} } + }, my $where_dq = $converter->_where_to_dq($self->{cond})); + \$where_dq; + }; + } } else { # we got this far - means it is time to wrap a subquery @@ -1953,14 +1932,19 @@ sub _rs_update_delete { my $subrs = (ref $self)->new($rsrc, $attrs); if (@$idcols == 1) { - $cond = { $idcols->[0] => { -in => $subrs->as_query } }; + $cond = { $idcols->[0] => { -in => \$subrs->_as_select_dq } }; } elsif ($storage->_use_multicolumn_in) { # no syntax for calling this properly yet # !!! EXPERIMENTAL API !!! WILL CHANGE !!! - $cond = $storage->sql_maker->_where_op_multicolumn_in ( - $idcols, # how do I convey a list of idents...? can binds reside on lhs? - $subrs->as_query + my $left = $storage->sql_maker->_render_sqla(select_select => $idcols); + $left =~ s/^SELECT //i; + my $right = $storage->sql_maker + ->converter + ->_literal_to_dq(${$subrs->as_query}); + $cond = \Operator( + { 'SQL.Naive' => 'in' }, + [ Literal(SQL => "( $left )"), $right ], ), } else { @@ -1970,6 +1954,8 @@ sub _rs_update_delete { if ( $existing_group_by or + # we do not need to check pre-multipliers, since if the premulti is there, its + # parent (who is multi) will be there too keys %{ $join_classifications->{multiplying} || {} } ) { # make sure if there is a supplied group_by it matches the columns compiled above @@ -2313,6 +2299,11 @@ sub populate { $rel, ); + if (ref($related) eq 'REF' and ref($$related) eq 'HASH') { + $related = $self->result_source + ->_extract_fixed_values_for($$related, $rel); + } + my @rows_to_add = ref $item->{$rel} eq 'ARRAY' ? @{$item->{$rel}} : ($item->{$rel}); my @populate = map { {%$_, %$related} } @rows_to_add; @@ -2322,7 +2313,6 @@ sub populate { } } - # populate() arguments went over several incarnations # What we ultimately support is AoH sub _normalize_populate_args { @@ -2487,16 +2477,7 @@ sub _merge_with_rscond { if (! defined $self->{cond}) { # just massage $data below } - elsif ($self->{cond} eq $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION) { - %new_data = %{ $self->{attrs}{related_objects} || {} }; # nothing might have been inserted yet - @cols_from_relations = keys %new_data; - } - elsif (ref $self->{cond} ne 'HASH') { - $self->throw_exception( - "Can't abstract implicit construct, resultset condition not a hash" - ); - } - else { + elsif (ref $self->{cond} eq 'HASH') { # precedence must be given to passed values over values inherited from # the cond, so the order here is important. my $collapsed_cond = $self->_collapse_cond($self->{cond}); @@ -2518,6 +2499,23 @@ sub _merge_with_rscond { } } } + elsif (ref $self->{cond} eq 'REF' and ref ${$self->{cond}} eq 'HASH') { + if ((${$self->{cond}})->{'DBIx::Class::ResultSource.UNRESOLVABLE'}) { + %new_data = %{ $self->{attrs}{related_objects} || {} }; # nothing might have been inserted yet + @cols_from_relations = keys %new_data; + } else { + %new_data = %{$self->_remove_alias( + $self->result_source + ->_extract_fixed_values_for(${$self->{cond}}), + $alias + )}; + } + } + else { + $self->throw_exception( + "Can't abstract implicit construct, resultset condition not a hash" + ); + } %new_data = ( %new_data, @@ -2665,6 +2663,19 @@ sub as_query { $aq; } +sub _as_select_dq { + my $self = shift; + my $attrs = { %{ $self->_resolved_attrs } }; + my $storage = $self->result_source->storage; + my (undef, $ident, @args) = $storage->_select_args( + $attrs->{from}, $attrs->{select}, $attrs->{where}, $attrs + ); + $ident = $ident->from if blessed($ident); + $storage->sql_maker->converter->_select_to_dq( + $ident, @args + ); +} + =head2 find_or_new =over 4 @@ -3425,6 +3436,9 @@ sub _resolved_attrs { my $source = $self->result_source; my $alias = $attrs->{alias}; + $self->throw_exception("Specifying distinct => 1 in conjunction with collapse => 1 is unsupported") + if $attrs->{collapse} and $attrs->{distinct}; + # default selection list $attrs->{columns} = [ $source->columns ] unless List::Util::first { exists $attrs->{$_} } qw/columns cols select as/; @@ -3535,22 +3549,9 @@ sub _resolved_attrs { $attrs->{group_by} = [ $attrs->{group_by} ]; } - # generate the distinct induced group_by early, as prefetch will be carried via a - # subquery (since a group_by is present) - if (delete $attrs->{distinct}) { - if ($attrs->{group_by}) { - carp_unique ("Useless use of distinct on a grouped resultset ('distinct' is ignored when a 'group_by' is present)"); - } - else { - $attrs->{_grouped_by_distinct} = 1; - # distinct affects only the main selection part, not what prefetch may - # add below. - $attrs->{group_by} = $source->storage->_group_over_selection($attrs); - } - } # generate selections based on the prefetch helper - my $prefetch; + my ($prefetch, @prefetch_select, @prefetch_as); $prefetch = $self->_merge_joinpref_attr( {}, delete $attrs->{prefetch} ) if defined $attrs->{prefetch}; @@ -3559,6 +3560,9 @@ sub _resolved_attrs { $self->throw_exception("Unable to prefetch, resultset contains an unnamed selector $attrs->{_dark_selector}{string}") if $attrs->{_dark_selector}; + $self->throw_exception("Specifying prefetch in conjunction with an explicit collapse => 0 is unsupported") + if defined $attrs->{collapse} and ! $attrs->{collapse}; + $attrs->{collapse} = 1; # this is a separate structure (we don't look in {from} directly) @@ -3584,12 +3588,9 @@ sub _resolved_attrs { my @prefetch = $source->_resolve_prefetch( $prefetch, $alias, $join_map ); - push @{ $attrs->{select} }, (map { $_->[0] } @prefetch); - push @{ $attrs->{as} }, (map { $_->[1] } @prefetch); - } - - if ( List::Util::first { $_ =~ /\./ } @{$attrs->{as}} ) { - $attrs->{_related_results_construction} = 1; + # save these for after distinct resolution + @prefetch_select = map { $_->[0] } @prefetch; + @prefetch_as = map { $_->[1] } @prefetch; } # run through the resulting joinstructure (starting from our current slot) @@ -3641,6 +3642,34 @@ sub _resolved_attrs { } } + # generate the distinct induced group_by before injecting the prefetched select/as parts + if (delete $attrs->{distinct}) { + if ($attrs->{group_by}) { + carp_unique ("Useless use of distinct on a grouped resultset ('distinct' is ignored when a 'group_by' is present)"); + } + else { + $attrs->{_grouped_by_distinct} = 1; + # distinct affects only the main selection part, not what prefetch may add below + ($attrs->{group_by}, my $new_order) = $source->storage->_group_over_selection($attrs); + + # FIXME possibly ignore a rewritten order_by (may turn out to be an issue) + # The thinking is: if we are collapsing the subquerying prefetch engine will + # rip stuff apart for us anyway, and we do not want to have a potentially + # function-converted external order_by + # ( there is an explicit if ( collapse && _grouped_by_distinct ) check in DBIHacks ) + $attrs->{order_by} = $new_order unless $attrs->{collapse}; + } + } + + # inject prefetch-bound selection (if any) + push @{$attrs->{select}}, @prefetch_select; + push @{$attrs->{as}}, @prefetch_as; + + # whether we can get away with the dumbest (possibly DBI-internal) collapser + if ( List::Util::first { $_ =~ /\./ } @{$attrs->{as}} ) { + $attrs->{_related_results_construction} = 1; + } + # 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 @@ -4433,8 +4462,17 @@ or with an in-place function in which case literal SQL is required: =back -Set to 1 to group by all columns. If the resultset already has a group_by -attribute, this setting is ignored and an appropriate warning is issued. +Set to 1 to automatically generate a L clause based on the selection +(including intelligent handling of L contents). Note that the group +criteria calculation takes place over the B selection. This includes +any L, L or L additions in subsequent +L calls, and standalone columns selected via +L (L). A notable exception are the +extra selections specified via L - such selections are explicitly +excluded from group criteria calculations. + +If the final ResultSet also explicitly defines a L attribute, this +setting is ignored and an appropriate warning is issued. =head2 where