From: Ash Berlin <ash_github@firemirror.com>
Date: Thu, 26 Mar 2009 20:41:06 +0000 (+0000)
Subject: Make a start on the Compat AST -> Explict AST tree walker
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FSQL-Abstract-2.0-ish.git;a=commitdiff_plain;h=d70ca1308bd4fd4000cd6190084da529aa108134

Make a start on the Compat AST -> Explict AST tree walker
---

diff --git a/Makefile.PL b/Makefile.PL
index ea994b3..810d684 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -8,6 +8,7 @@ requires 'Moose' => '0.71';
 requires 'MooseX::Method::Signatures' => '0.13_804d1448';
 requires 'MooseX::Declare' => '0.09';
 requires 'MooseX::Types::Structured' => '0.9';
+requires 'Devel::PartialDump' => '0.9';
 
 test_requires 'Test::More';
 test_requires 'Test::Differences';
diff --git a/lib/SQL/Abstract/AST/Compat.pm b/lib/SQL/Abstract/AST/Compat.pm
new file mode 100644
index 0000000..97e2fd3
--- /dev/null
+++ b/lib/SQL/Abstract/AST/Compat.pm
@@ -0,0 +1,127 @@
+use MooseX::Declare;
+
+class SQL::Abstract::AST::Compat {
+
+  use MooseX::Types::Moose qw/ArrayRef HashRef Str ScalarRef/;
+  use SQL::Abstract::Types qw/AST/;
+  use SQL::Abstract::Types::Compat ':all';
+  use Devel::PartialDump qw/dump/;
+  use Carp qw/croak/;
+
+  clean;
+
+  has logic => (
+    is => 'rw',
+    isa => LogicEnum,
+    default => 'AND'
+  );
+
+  method generate(WhereType $ast) returns (AST) {
+    return $self->recurse_where($ast);
+  }
+
+  method recurse_where(WhereType $ast, LogicEnum $logic?) returns (AST) {
+    return $self->recurse_where_hash($logic || 'AND', $ast) if is_HashRef($ast);
+    return $self->recurse_where_array($logic || 'OR', $ast) if is_ArrayRef($ast);
+    croak "Unknown where clause type " . dump($ast);
+  }
+
+  method recurse_where_hash(LogicEnum $logic, HashRef $ast) returns (AST) {
+    my @args;
+    my $ret = {
+      -type => 'expr',
+      op => lc $logic,
+      args => \@args
+    };
+
+    while (my ($key,$value) = each %$ast) {
+      if ($key =~ /^-(or|and)$/) {
+        my $val = $self->recurse_where($value, uc $1);
+        if ($val->{op} eq $ret->{op}) {
+          push @args, @{$val->{args}};
+        }
+        else {
+          push @args, $val;
+        }
+        next;
+      }
+
+      push @args, $self->field($key, $value);
+    }
+
+    return $args[0] if @args == 1;
+
+    return $ret;
+  }
+
+  method recurse_where_array(LogicEnum $logic, ArrayRef $ast) returns (AST) {
+    my @args;
+    my $ret = {
+      -type => 'expr',
+      op => lc $logic,
+      args => \@args
+    };
+    my @nodes = @$ast;
+
+    while (my $key = shift @nodes) {
+      if ($key =~ /^-(or|and)$/) {
+        my $value = shift @nodes
+          or confess "missing value after $key at " . dump($ast);
+
+        my $val = $self->recurse_where($value, uc $1);
+        if ($val->{op} eq $ret->{op}) {
+          push @args, @{$val->{args}};
+        }
+        else {
+          push @args, $val;
+        }
+        next;
+      }
+
+      push @args, $self->recurse_where($key);
+    }
+
+    return $args[0] if @args == 1;
+
+    return $ret;
+  }
+
+  method field(Str $key, $value) returns (AST) {
+    my $ret = {
+      -type => 'expr',
+      op => '==',
+      args => [
+        { -type => 'name', args => [$key] }
+      ],
+    };
+
+    if (is_Str($value)) {
+      push @{$ret->{args}}, { -type => 'value', value => $value };
+    }
+
+    return $ret;
+  }
+
+
+};
+
+1;
+
+=head1 NAME
+
+SQL::Abstract::AST::Compat - v1.xx AST -> v2 AST visitor
+
+=head1 DESCRIPTION
+
+The purpose of this module is to take the where clause arguments from version
+1.x of SQL::Abstract, and turn it into a proper, explicit AST, suitable for use
+in the rest of the code.
+
+Please note that this module does not have the same interface as other
+SQL::Abstract ASTs.
+
+=head1 AUTHOR
+
+Ash Berlin C<< <ash@cpan.org> >>
+
+=cut
diff --git a/lib/SQL/Abstract/Types/Compat.pm b/lib/SQL/Abstract/Types/Compat.pm
new file mode 100644
index 0000000..36dd455
--- /dev/null
+++ b/lib/SQL/Abstract/Types/Compat.pm
@@ -0,0 +1,14 @@
+use MooseX::Declare;
+
+class SQL::Abstract::Types::Compat {
+  use Moose::Util::TypeConstraints;
+  use MooseX::Types::Moose qw/ArrayRef Str Int Ref HashRef ScalarRef/;
+
+  clean;
+
+  use MooseX::Types -declare => [qw/LogicEnum WhereType/];
+
+  enum LogicEnum, qw(OR AND);
+
+  subtype WhereType, as Str|ArrayRef|HashRef|ScalarRef;
+}
diff --git a/t/compat/ast/01.t b/t/compat/ast/01.t
new file mode 100644
index 0000000..16397b9
--- /dev/null
+++ b/t/compat/ast/01.t
@@ -0,0 +1,85 @@
+use strict;
+use warnings;
+
+use SQL::Abstract::AST::Compat;
+
+use Test::More tests => 6;
+use Test::Differences;
+
+ok(my $visitor = SQL::Abstract::AST::Compat->new);
+
+my $foo_eq_1 = {
+  -type => 'expr',
+  op => '==',
+  args => [
+    { -type => 'name', args => [qw/foo/] }, 
+    { -type => 'value', value => 1 }
+  ]
+};
+
+eq_or_diff
+  $visitor->generate({ foo => 1 }),
+  $foo_eq_1,
+  "Single value hash";
+
+
+my $bar_eq_str = {
+  -type => 'expr',
+  op => '==',
+  args => [
+    { -type => 'name', args => [qw/bar/] }, 
+    { -type => 'value', value => 'some str' }
+  ]
+};
+
+eq_or_diff
+  $visitor->generate({ foo => 1, bar => 'some str' }),
+  { -type => 'expr',
+    op => 'and',
+    args => [
+      $bar_eq_str,
+      $foo_eq_1,
+    ]
+  },
+  "two keys in hash";
+
+eq_or_diff
+  $visitor->generate({ -or => { foo => 1, bar => 'some str' } }),
+  { -type => 'expr',
+    op => 'or',
+    args => [
+      $bar_eq_str,
+      $foo_eq_1,
+    ]
+  },
+  "-or key in hash";
+
+
+eq_or_diff
+  $visitor->generate([ -and => { foo => 1, bar => 'some str' } ]),
+  { -type => 'expr',
+    op => 'and',
+    args => [
+      $bar_eq_str,
+      $foo_eq_1,
+    ]
+  },
+  "-and as first element of array";
+
+
+eq_or_diff
+  $visitor->generate([ -and => { foo => 1, bar => 'some str' }, { foo => 1} ]),
+  { -type => 'expr',
+    op => 'or',
+    args => [
+      { -type => 'expr',
+        op => 'and',
+        args => [
+          $bar_eq_str,
+          $foo_eq_1,
+        ]
+      },
+      $foo_eq_1,
+    ]
+  },
+  "-and as first element of array";