From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sun, 17 Mar 2013 23:54:33 +0000 (+0000)
Subject: OracleJoins appears to produce correct SQL
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e4facd5aa39c28daa64f0996a557a053239c69cb;p=dbsrgits%2FDBIx-Class-Historic.git

OracleJoins appears to produce correct SQL
---

diff --git a/lib/DBIx/Class/SQLMaker/Renderer/OracleJoins.pm b/lib/DBIx/Class/SQLMaker/Renderer/OracleJoins.pm
index d5045c7..305fc47 100644
--- a/lib/DBIx/Class/SQLMaker/Renderer/OracleJoins.pm
+++ b/lib/DBIx/Class/SQLMaker/Renderer/OracleJoins.pm
@@ -1,21 +1,23 @@
 package DBIx::Class::SQLMaker::Renderer::OracleJoins;
 
 sub map_descending (&;@) {
-  my ($block, @in) = @_;
-  local $_;
-  map {
-    if (ref($_) eq 'REF' and ref($$_) eq 'HASH') {
-      $$_;
-    } elsif (ref($_) eq 'HASH') {
-      my $mapped = $block->($_);
-      local $_;
-      +{ map +($_ => &map_descending($block, $mapped->{$_})), keys %$mapped };
-    } elsif (ref($_) eq 'ARRAY') {
-      [ &map_descending($block, @$_) ]
-    } else {
-      $_
-    }
-  } @in;
+  my ($block, $in) = @_;
+  local $_ = $in;
+  $_ = $block->($_) if ref($_) eq 'HASH';
+#::Dwarn([mapped => $_]);
+  if (ref($_) eq 'REF' and ref($$_) eq 'HASH') {
+    $$_;
+  } elsif (ref($_) eq 'HASH') {
+#::Dwarn([unmapped => $_]);
+#::Dwarn([mapped => $mapped]);
+    my $mapped = $_;
+    local $_;
+    +{ map +($_ => &map_descending($block, $mapped->{$_})), keys %$mapped };
+  } elsif (ref($_) eq 'ARRAY') {
+    [ map &map_descending($block, $_), @$_ ]
+  } else {
+    $_
+  }
 }
 
 use Data::Query::ExprHelpers;
@@ -30,9 +32,11 @@ around render => sub {
 
 sub _oracle_joins_unroll {
   my ($self, $dq) = @_;
-  ::Dwarn map_descending {
+  map_descending {
+#warn "here";
+#::Dwarn([unroll => $_]);
     return $_ unless is_Join;
-    return $self->_oracle_joins_mangle_join($_);
+    return \$self->_oracle_joins_mangle_join($_);
   } $dq;
 }
 
@@ -40,7 +44,9 @@ sub _oracle_joins_mangle_join {
   my ($self, $dq) = @_;
   my ($mangled, $where) = $self->_oracle_joins_recurse_join($dq);
   Where(
-    Operator({ 'SQL.Naive' => 'and' }, $where),
+    (@$where > 1
+      ? Operator({ 'SQL.Naive' => 'and' }, $where)
+      : $where->[0]),
     $mangled
   );
 }
@@ -49,6 +55,7 @@ sub _oracle_joins_recurse_join {
   my ($self, $dq) = @_;
   die "Can't handle cross join" unless $dq->{on};
   my $mangled = { %$dq };
+  delete $mangled->{on};
   my @where;
   my %idents;
   foreach my $side (qw(left right)) {
@@ -63,9 +70,10 @@ sub _oracle_joins_recurse_join {
       } elsif (is_Alias($dq->{$side})) {
         $idents{$side} = { $dq->{$side}{to} => 1 };
       }
-      $mangled->{$side} = $self->_oracle_joins_unroll($dq->{side});
+      $mangled->{$side} = $self->_oracle_joins_unroll($dq->{$side});
     }
   }
+  my %other = (left => 'right', right => 'left');
   unshift @where, (
     $dq->{outer}
       ? map_descending {
@@ -75,7 +83,7 @@ sub _oracle_joins_recurse_join {
           die "Can't unroll single part identifiers in on"
             unless @{$_->{elements}} > 1;
           my $check = join($;, @{$_->{elements}}[0..($#{$_->{elements}}-1)]);
-          if ($idents{$dq->{outer}}{$check}) {
+          if ($idents{$other{$dq->{outer}}}{$check}) {
             return \Operator({ 'SQL.Naive' => '(+)' }, [ $_ ]);
           }
           return $_;