From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sat, 28 Jul 2012 18:56:32 +0000 (+0000)
Subject: add compose routine and refactor FetchFirst to functional style
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9fcc225601f7d6ee191af678513ae6e51ddb6cce;p=dbsrgits%2FData-Query.git

add compose routine and refactor FetchFirst to functional style
---

diff --git a/lib/Data/Query/ExprHelpers.pm b/lib/Data/Query/ExprHelpers.pm
index 6b2cbef..8c030d7 100644
--- a/lib/Data/Query/ExprHelpers.pm
+++ b/lib/Data/Query/ExprHelpers.pm
@@ -5,7 +5,7 @@ use Data::Query::Constants;
 
 use base qw(Exporter);
 
-our @EXPORT = qw(perl_scalar_value perl_operator Literal Identifier);
+our @EXPORT = qw(perl_scalar_value perl_operator Literal Identifier compose);
 
 sub perl_scalar_value {
   +{
@@ -81,4 +81,32 @@ foreach my $name (values %Data::Query::Constants::CONST) {
   }
 }
 
+sub compose (&@) {
+  my $code = shift;
+  require Scalar::Util;
+  my $type = Scalar::Util::reftype($code);
+  unless($type and $type eq 'CODE') {
+    require Carp;
+    Carp::croak("Not a subroutine reference");
+  }
+  no strict 'refs';
+
+  return shift unless @_ > 1;
+
+  use vars qw($a $b);
+
+  my $caller = caller;
+  local(*{$caller."::a"}) = \my $a;
+  local(*{$caller."::b"}) = \my $b;
+
+  $a = pop;
+  foreach (reverse @_) {
+    $b = $_;
+    $a = &{$code}();
+  }
+
+  $a;
+}
+
+
 1;
diff --git a/lib/Data/Query/Renderer/SQL/Slice/FetchFirst.pm b/lib/Data/Query/Renderer/SQL/Slice/FetchFirst.pm
index 5558074..7a3234d 100644
--- a/lib/Data/Query/Renderer/SQL/Slice/FetchFirst.pm
+++ b/lib/Data/Query/Renderer/SQL/Slice/FetchFirst.pm
@@ -1,6 +1,5 @@
 package Data::Query::Renderer::SQL::Slice::FetchFirst;
 
-use List::Util qw(reduce);
 use Data::Query::ExprHelpers;
 use Moo::Role;
 
@@ -87,42 +86,51 @@ sub _render_slice {
     push @order_nodes, $order;
     $order = $order->{from};
   }
-  my $inside_order = reduce {
-    Order($b->{by}, $b->{reverse}, $a)
-  } $order, reverse @order_nodes;
-  my $inside_select = Select(\@inside_select_list, $inside_order);
+  $default_inside_alias ||= 'me';
   my $limit_plus_offset = +{
     %{$dq->{limit}}, value => $dq->{limit}{value} + $dq->{offset}{value}
   };
-  $default_inside_alias ||= 'me';
-  my $bridge_from = Alias(
-    $default_inside_alias,
-    Slice(undef, $limit_plus_offset, $inside_select)
-  );
-  my $outside_order = reduce {
-    Order($order_map{$b->{by}}, !$b->{reverse}, $a)
-  } $bridge_from, reverse @order_nodes;
-  my $outside_select = Select(
-    (
+  my $inner_body = $order;
+  return $self->_render(
+    map {
       $dq->{preserve_order}
-        ? [
+        ? Select(
+          \@outside_select_list,
+          compose {
+            Order($order_map{$b->{by}}, $b->{reverse}, $a)
+          } @order_nodes, Alias($default_inside_alias, $_)
+        )
+        : $_
+    } Slice(
+        undef, $dq->{limit},
+        Select(
+          [
             @outside_select_list,
-            grep @{$_->{elements}} == 1, @order_map{map $_->{by}, @order_nodes}
-          ]
-        : \@outside_select_list,
-    ),
-    $outside_order,
+            $dq->{preserve_order}
+              ? (grep @{$_->{elements}} == 1,
+                  @order_map{map $_->{by}, @order_nodes})
+              : (),
+          ],
+          compose {
+            Order($order_map{$b->{by}}, !$b->{reverse}, $a)
+          } (
+            @order_nodes,
+            Alias(
+              $default_inside_alias,
+              Slice(
+                undef, $limit_plus_offset,
+                Select(
+                  \@inside_select_list,
+                  compose {
+                    Order($b->{by}, $b->{reverse}, $a)
+                  } @order_nodes, $inner_body
+                )
+              )
+            )
+          )
+        )
+      )
   );
-  my $final = Slice(undef, $dq->{limit}, $outside_select);
-  if ($dq->{preserve_order}) {
-    $final = Select(
-      \@outside_select_list,
-      reduce {
-        Order($order_map{$b->{by}}, $b->{reverse}, $a)
-      } Alias($default_inside_alias, $final), reverse @order_nodes
-    );
-  }
-  return $self->_render($final);
 }
 
 1;