From: Matt S Trout <mst@shadowcat.co.uk>
Date: Fri, 20 Apr 2012 10:03:30 +0000 (+0000)
Subject: Slice implementations as roles
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0446ca9c18ac30c9b39b0baac8b09e77adcbcd56;p=dbsrgits%2FData-Query.git

Slice implementations as roles
---

diff --git a/lib/Data/Query/Renderer/SQL/Naive.pm b/lib/Data/Query/Renderer/SQL/Naive.pm
index 1fdd5ef..c4ac4b3 100644
--- a/lib/Data/Query/Renderer/SQL/Naive.pm
+++ b/lib/Data/Query/Renderer/SQL/Naive.pm
@@ -7,7 +7,7 @@ sub intersperse { my $i = shift; my @i = map +($_, $i), @_; pop @i; @i }
 use SQL::ReservedWords;
 use Data::Query::Constants qw(
   DQ_IDENTIFIER DQ_OPERATOR DQ_VALUE DQ_JOIN DQ_ALIAS DQ_ORDER DQ_LITERAL
-  DQ_GROUP
+  DQ_GROUP DQ_SELECT DQ_SLICE
 );
 
 use Moo;
@@ -287,7 +287,7 @@ sub _render_select {
     ($dq->{from}
        ? ($self->_format_keyword('FROM'), @{$self->_render($dq->{from})})
        : ()
-    )
+    ),
   ];
 }
 
@@ -302,8 +302,11 @@ sub _render_alias {
       }
     }
   }
-  return [
-    $self->_render($dq->{from}),
+  my %parenthesise = map +($_ => 1), DQ_SELECT, DQ_SLICE;
+  return [ # XXX not sure this is the right place to detect this
+    ($parenthesise{$dq->{from}{type}}
+      ? [ '(', $self->_render($dq->{from}), ')' ]
+      : $self->_render($dq->{from})),
     $as || ' ',
     $self->_render_identifier({ elements => [ $dq->{to} ] })
   ];
@@ -363,7 +366,9 @@ sub _render_order {
   my @ret = (
     $self->_format_keyword('ORDER BY'),
     $self->_render($dq->{by}),
-    ($dq->{direction} ? $self->_format_keyword($dq->{direction}) : ())
+    (defined $dq->{reverse}
+      ? $self->_format_keyword($dq->{reverse} ? 'DESC' : 'ASC')
+      : ())
   );
   my $from;
   while ($from = $dq->{from}) {
@@ -372,7 +377,9 @@ sub _render_order {
     push @ret, (
       ',',
       $self->_render($dq->{by}),
-      ($dq->{direction} ? $self->_format_keyword($dq->{direction}) : ())
+      (exists $dq->{reverse}
+        ? $self->_format_keyword($dq->{reverse} ? 'DESC' : 'ASC')
+        : ())
     );
   }
   unshift @ret, $self->_render($from) if $from;
diff --git a/lib/Data/Query/Renderer/SQL/SQLite.pm b/lib/Data/Query/Renderer/SQL/SQLite.pm
index 4dac236..c44b2cb 100644
--- a/lib/Data/Query/Renderer/SQL/SQLite.pm
+++ b/lib/Data/Query/Renderer/SQL/SQLite.pm
@@ -4,15 +4,6 @@ use Moo;
 
 extends 'Data::Query::Renderer::SQL::Naive';
 
-sub _render_slice {
-  my ($self, $dq) = @_;
-  [ ($dq->{from} ? $self->_render($dq->{from}) : ()),
-    $self->_format_keyword('LIMIT'), $self->_render($dq->{limit}),
-    ($dq->{offset}
-      ? ($self->_format_keyword('OFFSET'), $self->_render($dq->{offset}))
-      : ()
-    ),
-  ];
-}
+with 'Data::Query::Renderer::SQL::Slice::LimitOffset';
 
 1;
diff --git a/lib/Data/Query/Renderer/SQL/Slice/FetchFirst.pm b/lib/Data/Query/Renderer/SQL/Slice/FetchFirst.pm
new file mode 100644
index 0000000..6dd07fe
--- /dev/null
+++ b/lib/Data/Query/Renderer/SQL/Slice/FetchFirst.pm
@@ -0,0 +1,155 @@
+package Data::Query::Renderer::SQL::Slice::FetchFirst;
+
+use Data::Query::Constants qw(
+  DQ_SELECT DQ_ALIAS DQ_IDENTIFIER DQ_ORDER DQ_SLICE
+);
+use Moo::Role;
+
+sub _render_slice {
+  my ($self, $dq) = @_;
+  unless ($dq->{offset}) {
+    return [
+      ($dq->{from} ? $self->_render($dq->{from}) : ()),
+      $self->_format_keyword('FETCH FIRST'),
+      sprintf("%i", $dq->{limit}{value}),
+      $self->_format_keyword('ROWS ONLY')
+    ];
+  }
+  unless ($dq->{order_is_stable}) {
+    die "FetchFirst limit style requires a stable order";
+  }
+  die "Slice's inner is not a Select"
+    unless (my $orig_select = $dq->{from})->{type} eq DQ_SELECT;
+  my %alias_map;
+  my $gensym_count;
+  my (@inside_select_list, @outside_select_list);
+  my $default_inside_alias;
+  SELECT: foreach my $s (@{$orig_select->{select}}) {
+    my $name;
+    if ($s->{type} eq DQ_ALIAS) {
+      $name = $s->{to};
+      $s = $s->{from};
+    }
+    my $key;
+    if ($s->{type} eq DQ_IDENTIFIER) {
+      if (@{$s->{elements}} == 2) {
+        $default_inside_alias ||= $s->{elements}[0];
+        if ($s->{elements}[0] eq $default_inside_alias) {
+          $alias_map{join('.',@{$s->{elements}})} = $s;
+          push @inside_select_list, $s;
+          push @outside_select_list, $s;
+          next SELECT;
+        }
+      }
+      $name ||= join('__', @{$s->{elements}});
+      $key = join('.', @{$s->{elements}});
+    } else {
+      die "XXX not implemented yet";
+    }
+    $name ||= 'GENSYM__'.++$gensym_count;
+    push @inside_select_list, +{
+      type => DQ_ALIAS,
+      from => $s,
+      to => $name,
+    };
+    push @outside_select_list, $alias_map{$key} = +{
+      type => DQ_IDENTIFIER,
+      elements => [ $name ]
+    };
+  }
+  my $order = $orig_select->{from};
+  my $order_gensym_count;
+  die "Slice's Select not followed by Order but order_is_stable set"
+    unless $order->{type} eq DQ_ORDER;
+  my (@order_nodes, %order_map);
+  while ($order->{type} eq DQ_ORDER) {
+    my $by = $order->{by};
+    if ($by->{type} eq DQ_IDENTIFIER) {
+      $order_map{$by}
+        = $alias_map{join('.', @{$by->{elements}})}
+          ||= do {
+                my $name = 'ORDER__BY__'.++$order_gensym_count;
+                push @inside_select_list, +{
+                  type => DQ_ALIAS,
+                  from => $by,
+                  to => $name
+                };
+                +{
+                  type => DQ_IDENTIFIER,
+                  elements => [ $name ],
+                };
+              };
+    } else {
+      die "XXX not implemented yet";
+    }
+    push @order_nodes, $order;
+    $order = $order->{from};
+  }
+  my $inside_order = $order;
+  $inside_order = +{
+    type => DQ_ORDER,
+    by => $_->{by},
+    reverse => $_->{reverse},
+    from => $inside_order
+  } for reverse @order_nodes;
+  my $inside_select = +{
+    type => DQ_SELECT,
+    select => \@inside_select_list,
+    from => $inside_order,
+  };
+  my $limit_plus_offset = +{
+    %{$dq->{limit}}, value => $dq->{limit}{value} + $dq->{offset}{value}
+  };
+  $default_inside_alias ||= 'me';
+  my $bridge_from = +{
+    type => DQ_ALIAS,
+    to => $default_inside_alias,
+    from => {
+      type => DQ_SLICE,
+      limit => $limit_plus_offset,
+      from => $inside_select,
+    },
+  };
+  my $outside_order = $bridge_from;
+  $outside_order = +{
+    type => DQ_ORDER,
+    by => $order_map{$_->{by}},
+    reverse => !$_->{reverse},
+    from => $outside_order
+  } for reverse @order_nodes;
+  my $outside_select = +{
+    type => DQ_SELECT,
+    select => (
+      $dq->{preserve_order}
+        ? [ @outside_select_list, @order_map{map $_->{by}, @order_nodes} ]
+        : \@outside_select_list,
+    ),
+    from => $outside_order,
+  };
+  my $final = {
+    type => DQ_SLICE,
+    limit => $dq->{limit},
+    from => $outside_select
+  };
+  if ($dq->{preserve_order}) {
+    $final = {
+      type => DQ_ALIAS,
+      from => $final,
+      to => $default_inside_alias,
+    };
+    $final = +{
+      type => DQ_ORDER,
+      by => $order_map{$_->{by}},
+      reverse => $_->{reverse},
+      from => $final
+    } for reverse @order_nodes;
+    $final = {
+      type => DQ_SELECT,
+      select => \@outside_select_list,
+      from => $final,
+    };
+  }
+  return $self->_render($final);
+}
+
+1;
diff --git a/lib/Data/Query/Renderer/SQL/Slice/LimitOffset.pm b/lib/Data/Query/Renderer/SQL/Slice/LimitOffset.pm
new file mode 100644
index 0000000..54ef3f7
--- /dev/null
+++ b/lib/Data/Query/Renderer/SQL/Slice/LimitOffset.pm
@@ -0,0 +1,15 @@
+package Data::Query::Renderer::SQL::Slice::LimitOffset;
+
+use Moo::Role;
+
+sub _render_slice {
+  my ($self, $dq) = @_;
+  [ ($dq->{from} ? $self->_render($dq->{from}) : ()),
+    $self->_format_keyword('LIMIT'), $self->_render($dq->{limit}),
+    ($dq->{offset}
+      ? ($self->_format_keyword('OFFSET'), $self->_render($dq->{offset}))
+      : ()),
+  ];
+}
+
+1;