X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSet.pm;h=d6c5e9bdc58eb8dc78346750faf60fbc13502fde;hb=refs%2Fheads%2Fcurrent%2Fdq;hp=346eb395344f6e3ccd6c89090eb87674433f79de;hpb=4424330663ce24ad915f8fe9c36c6076f58eae8a;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index 346eb39..d6c5e9b 100644
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -248,7 +248,7 @@ sub new {
     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;
@@ -399,14 +399,7 @@ sub search_rs {
   }
 
   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)
@@ -420,6 +413,18 @@ sub search_rs {
     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}} };
@@ -500,44 +505,6 @@ sub search_rs {
   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) = @_;
@@ -654,6 +621,87 @@ sub _stack_cond {
   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
@@ -1364,7 +1412,7 @@ sub _construct_results {
   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} } ) {
@@ -2703,8 +2751,6 @@ sub as_query {
     $attrs->{from}, $attrs->{select}, $attrs->{where}, $attrs
   );
 
-  $self->{_attrs}{_sqlmaker_select_args} = $attrs->{_sqlmaker_select_args};
-
   $aq;
 }