first cut of rno sketch

[dbsrgits/Data-Query.git] / lib / Data / Query / Renderer / SQL / Slice / RowNumberOver.pm

diff --git a/lib/Data/Query/Renderer/SQL/Slice/RowNumberOver.pm b/lib/Data/Query/Renderer/SQL/Slice/RowNumberOver.pm
new file mode 100644 (file)
index 0000000..a6c5f9a
--- /dev/null
+++ b/lib/Data/Query/Renderer/SQL/Slice/RowNumberOver.pm
@@ -0,0 +1,180 @@
+package Data::Query::Renderer::SQL::Slice::RowNumberOver;
+
+use Data::Query::Constants qw(
+  DQ_SELECT DQ_ALIAS DQ_IDENTIFIER DQ_ORDER DQ_SLICE DQ_WHERE DQ_OPERATOR
+  DQ_LITERAL
+);
+use Moo::Role;
+
+sub _render_slice {
+  my ($self, $dq) = @_;
+  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 (!$name and @{$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" unless $name;
+      $key = "$s";
+    }
+    $name ||= sprintf("GENSYM__%03i",++$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;
+  my (@order_nodes, %order_map);
+  while ($order->{type} eq DQ_ORDER) {
+    my $by = $order->{by};
+    if ($by->{type} eq DQ_IDENTIFIER) {
+      $default_inside_alias ||= $by->{elements}[0]
+        if @{$by->{elements}} == 2;
+      $order_map{$by}
+        = $alias_map{join('.', @{$by->{elements}})}
+          ||= do {
+                if (
+                  @{$by->{elements}} == 2
+                  and $by->{elements}[0] eq $default_inside_alias
+                ) {
+                  $by;
+                } else {
+                  my $name = sprintf("ORDER__BY__%03i",++$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,
+  };
+  $default_inside_alias ||= 'me';
+  my $bridge_from = +{
+    type => DQ_ALIAS,
+    from => $inside_select,
+    to => $default_inside_alias,
+  };
+  my $outside_order;
+  $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 => [
+      @outside_select_list,
+      {
+        type => DQ_ALIAS,
+        from => $self->_rno_literal($outside_order),
+        to => 'rno__row__index',
+      }
+    ],
+    from => $bridge_from,
+  };
+  my $idx_name = +{
+    type => DQ_IDENTIFIER,
+    elements => [ 'rno__row__index' ],
+  };
+  my $offset_value = $dq->{offset} ? $dq->{offset}{value} : 0;
+  my $final = +{
+    type => DQ_WHERE,
+    where => {
+      type => DQ_OPERATOR,
+      operator => { 'SQL.Naive' => 'AND' },
+      args => [
+        {
+          type => DQ_OPERATOR,
+          operator => { 'SQL.Naive' => '>=' },
+          args => [
+            $idx_name,
+            { %{$dq->{limit}}, value => $offset_value + 1 },
+          ]
+        },
+        {
+          type => DQ_OPERATOR,
+          operator => { 'SQL.Naive' => '<=' },
+          args => [
+            $idx_name,
+            { %{$dq->{limit}}, value => $dq->{limit}{value} + $offset_value },
+          ]
+        },
+      ],
+    },
+    from => {
+      type => DQ_SELECT,
+      select => \@outside_select_list,
+      from => {
+        type => DQ_ALIAS,
+        from => $outside_select,
+        to => $default_inside_alias,
+      },
+    }
+  };
+  return $self->_render($final);
+}
+
+sub _rno_literal {
+  my ($self, $order) = @_;
+  my ($order_str, @order_bind) = (
+    $order
+      ? $self->render($order)
+      : ('')
+  );
+  return +{
+    type => DQ_LITERAL,
+    subtype => 'SQL',
+    literal => "ROW_NUMBER() OVER( $order_str )",
+    values => \@order_bind
+  };
+}
+
+1;