if $source->isa('DBIx::Class::ResultSourceHandle');
$attrs = { %{$attrs||{}} };
- delete @{$attrs}{qw(_sqlmaker_select_args _related_results_construction)};
+ delete @{$attrs}{qw(_last_sqlmaker_alias_map _related_results_construction)};
if ($attrs->{page}) {
$attrs->{rows} ||= 10;
}
if (blessed($call_cond) and $call_cond->isa('Data::Query::ExprBuilder')) {
- my ($mapped_expr, $extra_join)
- = $self->_remap_identifiers($call_cond->{expr});
- $call_cond = \$mapped_expr;
- if (@$extra_join) {
- $self->throw_exception("Can't handle join-requiring DQ expr when join attribute specified")
- if $call_attrs->{join};
- $call_attrs->{join} = $extra_join;
- }
+ $call_cond = \$call_cond->{expr};
}
# see if we can keep the cache (no $rs changes)
ref $call_cond eq 'ARRAY' && ! @$call_cond
)) {
$cache = $self->get_cache;
+ } elsif (
+ $self->{attrs}{cache} and
+ ($self->{attrs}{grep_cache} or $call_attrs->{grep_cache})
+ ) {
+ if (
+ keys %$call_attrs
+ and not (exists $call_attrs->{grep_cache} and !$call_attrs->{grep_cache})
+ ) {
+ die "Can't do complex search on resultset with grep_cache set";
+ }
+ my $grep_one = $self->_construct_perl_predicate($call_cond);
+ $cache = [ grep $grep_one->($_), $self->all ];
}
my $old_attrs = { %{$self->{attrs}} };
return $rs;
}
-sub _remap_identifiers {
- my ($self, $dq) = @_;
- my $map = {};
- my $attrs = $self->_resolved_attrs;
- foreach my $j ( @{$attrs->{from}}[1 .. $#{$attrs->{from}} ] ) {
- next unless $j->[0]{-alias};
- next unless $j->[0]{-join_path};
- my $p = $map;
- $p = $p->{$_} ||= {} for map { keys %$_ } @{$j->[0]{-join_path}};
- $p->{''} = $j->[0]{-alias};
- }
-
- my $seen_join = { %{$attrs->{seen_join}||{}} };
- my $storage = $self->result_source->storage;
- my @need_join;
- my $mapped = map_dq_tree {
- return $_ unless is_Identifier;
- my @el = @{$_->{elements}};
- my $last = pop @el;
- unless (@el) {
- return Identifier($attrs->{alias}, $last);
- }
- my $p = $map;
- $p = $p->{$_} ||= {} for @el;
- if (my $alias = $p->{''}) {
- return Identifier($alias, $last);
- }
- my $need = my $j = {};
- $j = $j->{$_} = {} for @el;
- push @need_join, $need;
- my $alias = $storage->relname_to_table_alias(
- $el[-1], ++$seen_join->{$el[-1]}
- );
- return Identifier($alias, $last);
- } $dq;
- return ($mapped, \@need_join);
-}
-
my $dark_sel_dumper;
sub _normalize_selection {
my ($self, $attrs) = @_;
return \Operator({ 'SQL.Naive' => 'AND' }, \@uniq);
}
+my %perl_op_map = (
+ '=' => { numeric => '==', string => 'eq' },
+);
+
+sub _construct_perl_predicate {
+ my ($self, $cond) = @_;
+
+ # This shouldn't really live here but it'll do for the moment.
+
+ my %alias_map = (
+ $self->current_source_alias => {
+ join_path => [],
+ source => $self->result_source,
+ columns_info => $self->result_source->columns_info,
+ },
+ );
+
+ my $attrs = $self->_resolved_attrs;
+ foreach my $j ( @{$attrs->{from}}[1 .. $#{$attrs->{from}} ] ) {
+ next unless $j->[0]{-alias};
+ next unless $j->[0]{-join_path};
+ $alias_map{$j->[0]{-alias}} = {
+ join_path => [ map { keys %$_ } @{$j->[0]{-join_path}} ],
+ source => $j->[0]{-rsrc},
+ columns_info => $j->[0]{-rsrc}->columns_info,
+ };
+ }
+
+ my %as_map = map +($attrs->{select}[$_] => $attrs->{as}[$_]),
+ grep !ref($attrs->{select}[$_]), 0..$#{$attrs->{select}};
+
+ my $storage = $self->result_source->schema->storage;
+ my $sql_maker = $storage->sql_maker;
+ my $tree = map_dq_tree {
+ if (is_Operator) {
+ my $op = $_->{operator}{'SQL.Naive'} or die "No operator";
+ if (lc($op) =~ /^(?:and|or|not)$/i) {
+ return Operator({ 'Perl' => lc($op) }, $op->{args});
+ }
+ if (my $op_map = $perl_op_map{$op}) {
+ die "Binop doesn't have two args - wtf?"
+ unless @{$_->{args}} == 2;
+ my $data_type;
+ my @mapped_args = map {
+ if (is_Identifier) {
+ die "Identifier not alias.colname"
+ unless @{$_->{elements}} == 2;
+ my ($alias, $col) = @{$_->{elements}};
+ die "${alias}.${col} not selected"
+ unless $as_map{"${alias}.${col}"};
+ unless ($data_type) {
+ my $colinfo = $alias_map{$alias}{columns_info}{$col};
+ unless (defined $colinfo->{is_numeric}) {
+ $colinfo->{is_numeric} = (
+ $storage->is_datatype_numeric($colinfo->{data_type})
+ ? 1
+ : 0
+ );
+ }
+ $data_type = $colinfo->{is_numeric} ? 'numeric' : 'string';
+ }
+ Identifier(@{$alias_map{$alias}{join_path}}, $col);
+ } elsif (is_Value) {
+ $_;
+ } else {
+ die "Argument to operator neither identifier nor value";
+ }
+ } @{$_->{args}};
+ die "Couldn't determine numeric versus string" unless $data_type;
+ return \Operator({ Perl => $op_map->{$data_type} }, \@mapped_args);
+ }
+ }
+ die "Unable to map node to perl";
+ } $sql_maker->converter->_where_to_dq($cond);
+ my ($code, @values) = @{$storage->perl_renderer->render($tree)};
+ my $sub = eval q!sub { !.$code.q! }!
+ or die "Failed to build sub: $@";
+ my @args = map $_->{value}, @values;
+ return sub { local $_ = $_[0]; $sub->(@args) };
+}
+
=head2 search_literal
B<CAVEAT>: C<search_literal> is provided for Class::DBI compatibility and
return undef unless @{$rows||[]};
# sanity check - people are too clever for their own good
- if ($attrs->{collapse} and my $aliastypes = $attrs->{_sqlmaker_select_args}[3]{_aliastypes} ) {
+ if ($attrs->{collapse} and my $aliastypes = $attrs->{_last_sqlmaker_alias_map} ) {
my $multiplied_selectors;
for my $sel_alias ( grep { $_ ne $attrs->{alias} } keys %{ $aliastypes->{selecting} } ) {
$attrs->{from}, $attrs->{select}, $attrs->{where}, $attrs
);
- $self->{_attrs}{_sqlmaker_select_args} = $attrs->{_sqlmaker_select_args};
-
$aq;
}
projects / dbsrgits/DBIx-Class.git / blobdiff