X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBIHacks.pm;h=e3fef8b3470265212417dcd53c1d225851ff5b35;hb=0488c7e1294791e01dc75dfe633454d0f4201384;hp=80283dc3c54b3661642d60c32adcafbe67788d44;hpb=2231d31c29347c34a6b58b88782da220775bddaa;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBIHacks.pm b/lib/DBIx/Class/Storage/DBIHacks.pm index 80283dc..e3fef8b 100644 --- a/lib/DBIx/Class/Storage/DBIHacks.pm +++ b/lib/DBIx/Class/Storage/DBIHacks.pm @@ -16,6 +16,8 @@ use mro 'c3'; use List::Util 'first'; use Scalar::Util 'blessed'; use Sub::Name 'subname'; +use Data::Query::Constants; +use Data::Query::ExprHelpers; use namespace::clean; # @@ -176,7 +178,7 @@ sub _adjust_select_args_for_complex_prefetch { # join collapse *will not work* on heavy data types. my $connecting_aliastypes = $self->_resolve_aliastypes_from_select_args({ %$inner_attrs, - select => [], + select => undef, }); for (sort map { keys %{$_->{-seen_columns}||{}} } map { values %$_ } values %$connecting_aliastypes) { @@ -411,16 +413,29 @@ sub _resolve_aliastypes_from_select_args { $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); # generate sql chunks my $to_scan = { restricting => [ - $sql_maker->_recurse_where ($attrs->{where}), - $sql_maker->_parse_rs_attrs ({ having => $attrs->{having} }), + ($attrs->{where} + ? ($sql_maker->_recurse_where($attrs->{where}))[0] + : () + ), + ($attrs->{having} + ? ($sql_maker->_recurse_where($attrs->{having}))[0] + : () + ), ], grouping => [ - $sql_maker->_parse_rs_attrs ({ group_by => $attrs->{group_by} }), + ($attrs->{group_by} + ? ($sql_maker->_render_sqla(group_by => $attrs->{group_by}))[0] + : (), + ) ], joining => [ $sql_maker->_recurse_from ( @@ -429,7 +444,7 @@ sub _resolve_aliastypes_from_select_args { ), ], selecting => [ - map { $sql_maker->_recurse_fields($_) } @{$attrs->{select}}, + map { $sql_maker->_render_sqla(select_select => $_) =~ /^SELECT\s+(.+)/ } @{$attrs->{select}||[]}, ], ordering => [ map { $_->[0] } $self->_extract_order_criteria ($attrs->{order_by}, $sql_maker), @@ -559,7 +574,8 @@ sub _group_over_selection { } } - my @order_by = $self->_extract_order_criteria($attrs->{order_by}) + my $sql_maker = $self->sql_maker; + my @order_by = $self->_extract_order_criteria($attrs->{order_by}, $sql_maker) or return (\@group_by, $attrs->{order_by}); # add any order_by parts that are not already present in the group_by @@ -571,7 +587,7 @@ sub _group_over_selection { # the proper overall order without polluting the group criteria (and # possibly changing the outcome entirely) - my ($leftovers, $sql_maker, @new_order_by, $order_chunks, $aliastypes); + my ($leftovers, @new_order_by, $order_chunks, $aliastypes); my $group_already_unique = $self->_columns_comprise_identifying_set($colinfos, \@group_by); @@ -635,21 +651,34 @@ sub _group_over_selection { # pesky tests won't pass # wrap any part of the order_by that "responds" to an ordering alias # into a MIN/MAX - $sql_maker ||= $self->sql_maker; - $order_chunks ||= [ - map { ref $_ eq 'ARRAY' ? $_ : [ $_ ] } $sql_maker->_order_by_chunks($attrs->{order_by}) - ]; - my ($chunk, $is_desc) = $sql_maker->_split_order_chunk($order_chunks->[$o_idx][0]); + $order_chunks ||= do { + my @c; + my $dq_node = $sql_maker->converter->_order_by_to_dq($attrs->{order_by}); - $new_order_by[$o_idx] = \[ - sprintf( '%s( %s )%s', - ($is_desc ? 'MAX' : 'MIN'), - $chunk, - ($is_desc ? ' DESC' : ''), - ), - @ {$order_chunks->[$o_idx]} [ 1 .. $#{$order_chunks->[$o_idx]} ] - ]; + while (is_Order($dq_node)) { + push @c, { + is_desc => $dq_node->{reverse}, + dq_node => $dq_node->{by}, + }; + + @{$c[-1]}{qw(sql bind)} = $sql_maker->_render_dq($dq_node->{by}); + + $dq_node = $dq_node->{from}; + } + + \@c; + }; + + $new_order_by[$o_idx] = { + ($order_chunks->[$o_idx]{is_desc} ? '-desc' : '-asc') => \[ + sprintf ( '%s( %s )', + ($order_chunks->[$o_idx]{is_desc} ? 'MAX' : 'MIN'), + $order_chunks->[$o_idx]{sql}, + ), + @{ $order_chunks->[$o_idx]{bind} || [] } + ] + }; } } @@ -662,7 +691,10 @@ sub _group_over_selection { # recreate the untouched order parts if (@new_order_by) { - $new_order_by[$_] ||= \ $order_chunks->[$_] for ( 0 .. $#$order_chunks ); + $new_order_by[$_] ||= { + ( $order_chunks->[$_]{is_desc} ? '-desc' : '-asc' ) + => \ $order_chunks->[$_]{dq_node} + } for ( 0 .. $#$order_chunks ); } return ( @@ -833,55 +865,38 @@ sub _inner_join_to_node { } sub _extract_order_criteria { - my ($self, $order_by, $sql_maker) = @_; - - my $parser = sub { - my ($sql_maker, $order_by, $orig_quote_chars) = @_; + my ($self, $order_by, $sql_maker, $ident_only) = @_; - return scalar $sql_maker->_order_by_chunks ($order_by) - unless wantarray; + $sql_maker ||= $self->sql_maker; - my ($lq, $rq, $sep) = map { quotemeta($_) } ( - ($orig_quote_chars ? @$orig_quote_chars : $sql_maker->_quote_chars), - $sql_maker->name_sep - ); - - my @chunks; - for ($sql_maker->_order_by_chunks ($order_by) ) { - my $chunk = ref $_ ? [ @$_ ] : [ $_ ]; - ($chunk->[0]) = $sql_maker->_split_order_chunk($chunk->[0]); + my $order_dq = $sql_maker->converter->_order_by_to_dq($order_by); - # order criteria may have come back pre-quoted (literals and whatnot) - # this is fragile, but the best we can currently do - $chunk->[0] =~ s/^ $lq (.+?) $rq $sep $lq (.+?) $rq $/"$1.$2"/xe - or $chunk->[0] =~ s/^ $lq (.+) $rq $/$1/x; + my @by; + while (is_Order($order_dq)) { + push @by, $order_dq->{by}; + $order_dq = $order_dq->{from}; + } - push @chunks, $chunk; + # delete local is 5.12+ + local @{$sql_maker}{qw(quote_char renderer converter)}; + delete @{$sql_maker}{qw(quote_char renderer converter)}; + + return map { [ $sql_maker->_render_dq($_) ] } do { + if ($ident_only) { + my @by_ident; + scan_dq_nodes({ DQ_IDENTIFIER ,=> sub { push @by_ident, $_[0] } }, @by); + @by_ident + } else { + @by } - - return @chunks; }; - - if ($sql_maker) { - return $parser->($sql_maker, $order_by); - } - else { - $sql_maker = $self->sql_maker; - - # pass these in to deal with literals coming from - # the user or the deep guts of prefetch - my $orig_quote_chars = [$sql_maker->_quote_chars]; - - local $sql_maker->{quote_char}; - return $parser->($sql_maker, $order_by, $orig_quote_chars); - } } sub _order_by_is_stable { my ($self, $ident, $order_by, $where) = @_; my @cols = ( - (map { $_->[0] } $self->_extract_order_criteria($order_by)), + (map { $_->[0] } $self->_extract_order_criteria($order_by, undef, 1)), $where ? @{$self->_extract_fixed_condition_columns($where)} :(), ) or return undef; @@ -993,6 +1008,12 @@ sub _main_source_order_by_portion_is_stable { sub _extract_fixed_condition_columns { my ($self, $where) = @_; + if (ref($where) eq 'REF' and ref($$where) eq 'HASH') { + # Yes. I know. + my $fixed = DBIx::Class::ResultSource->_extract_fixed_values_for($$where); + return [ keys %$fixed ]; + } + return unless ref $where eq 'HASH'; my @cols;