From: Ash Berlin <ash_github@firemirror.com>
Date: Mon, 2 Mar 2009 00:17:40 +0000 (+0000)
Subject: Produce half decent where clauses
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3e63a4d531227806e4492e0f126bc5d2dbb9e6ac;p=dbsrgits%2FSQL-Abstract-2.0-ish.git

Produce half decent where clauses
---

diff --git a/Makefile.PL b/Makefile.PL
index a32a5fb..b208fbb 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -3,9 +3,10 @@ use warnings;
 
 use inc::Module::Install 0.79;
 
+name 'SQL-Abstract';
 requires 'Moose' => '0.71';
-requires 'MooseX::Method::Signatures' => '0.07';
-requires 'MooseX::Declare' => '0.04';
+requires 'MooseX::Method::Signatures' => '0.10';
+requires 'MooseX::Declare' => '0.07';
 
 test_requires 'Test::More';
 
diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm
index 7c89615..4e7fcb8 100644
--- a/lib/SQL/Abstract.pm
+++ b/lib/SQL/Abstract.pm
@@ -8,7 +8,7 @@ class SQL::Abstract {
   use Data::Dump qw/pp/;
 
   use Moose::Util::TypeConstraints;
-  use MooseX::Types -declare => ['NameSeparator'];
+  use MooseX::Types -declare => [qw/NameSeparator/];
   use MooseX::Types::Moose qw/ArrayRef Str/;
   use MooseX::AttributeHelpers;
 
@@ -25,6 +25,19 @@ class SQL::Abstract {
 
   our $AST_VERSION = '1';
 
+  # Operator precedence for bracketing
+  our %PRIO = (
+    and => 10,
+    or  => 50
+  );
+
+  our %OP_MAP = (
+    '>' => '>',
+    '<' => '<',
+    '==' => '=',
+    '!=' => '!=',
+  );
+
   has name_separator => ( 
     is => 'rw', 
     isa => NameSeparator,
@@ -50,8 +63,8 @@ class SQL::Abstract {
     }
   );
 
-  method generate (ArrayRef $ast) {
-    $self = new $self unless blessed($self);
+  method generate (Object|ClassName $self: ArrayRef $ast) {
+    $self = $self->new unless blessed($self);
 
     local $_ = $ast->[0];
     s/^-/_/ or croak "Unknown type tag '$_'";
@@ -100,24 +113,54 @@ class SQL::Abstract {
 
   method _where(ArrayRef $ast) {
     my (undef, @clauses) = @$ast;
+  
+    $DB::single = 1;
+    return 'WHERE ' . $self->_recurse_where(\@clauses);
+  }
 
-    my @output;
+  method _recurse_where($clauses) {
+    $DB::single = 1;
+
+    my $OP = 'AND';
+    my $prio = $PRIO{and};
+    my $first = $clauses->[0];
 
-    foreach (@clauses) {
+    if (!ref $first && $first =~ /^-(and|or)$/) {
+      $OP = uc($1);
+      $prio = $PRIO{$1};
+      shift @$clauses;
+    }
+
+    my @output;
+    foreach (@$clauses) {
       my $op = $_->[0];
 
       unless (substr($op, 0, 1) eq '-') {
         # A simple comparison op (==, >, etc.)
-        croak "Binary operator $op expects 2 children, got " . $#$_
-          if @{$_} > 3;
-
-        push @output, $self->generate($_->[1]), 
-                      $op,
-                      $self->generate($_->[2]);
+        
+        push @output, $self->_binop(@$_);
+        
+      } elsif ($op =~ /^-(and|or)$/) {
+        my $sub_prio = $PRIO{$1}; 
+
+        if ($sub_prio >= $prio) {
+          push @output, $self->_recurse_where($_);
+        } else {
+          push @output, '(' . $self->_recurse_where($_) . ')';
+        }
+      } else {
+        push @output, $self->generate($_);
       }
     }
 
-    return join(' ', 'WHERE', @output);
+    return wantarray ? @output : join(" $OP ", @output);
+  }
+
+  method _binop($op, $lhs, $rhs) {
+    join (' ', $self->generate($lhs), 
+               $OP_MAP{$op} || croak("Unknown binary operator $op"),
+               $self->generate($rhs)
+    );
   }
 
   method _generic_func(ArrayRef $ast) {
diff --git a/t/001_basic.t b/t/001_basic.t
index de18152..0ad697f 100644
--- a/t/001_basic.t
+++ b/t/001_basic.t
@@ -1,10 +1,11 @@
 use strict;
 use warnings;
 
-use Test::More tests => 5;
+use Test::More tests => 9;
 
 use_ok('SQL::Abstract') or BAIL_OUT( "$@" );
 
+    $DB::single = 1;
 is SQL::Abstract->generate( [ -name => qw/me id/]), "me.id",
   "Simple name generator";
 
@@ -27,3 +28,40 @@ is SQL::Abstract->generate(
       [ '>', [-name => qw/me.id/], [-value => 500 ] ]
   ]
 ), "WHERE me.id > ?", "where clause";
+
+
+is SQL::Abstract->generate(
+  [ -where =>
+      [ '>', [-name => qw/me.id/], [-value => 500 ] ],
+      [ '==', [-name => qw/me.name/], [-value => '200' ] ]
+  ]
+), "WHERE me.id > ? AND me.name = ?", "where clause";
+
+
+is SQL::Abstract->generate(
+  [ -where =>  -or =>
+      [ '>', [-name => qw/me.id/], [-value => 500 ] ],
+      [ '==', [-name => qw/me.name/], [-value => '200' ] ],
+  ]
+), "WHERE me.id > ? OR me.name = ?", "where clause";
+
+
+is SQL::Abstract->generate(
+  [ -where =>  -or =>
+      [ '>', [-name => qw/me.id/], [-value => 500 ] ],
+      [ -or => 
+        [ '==', [-name => qw/me.name/], [-value => '200' ] ],
+        [ '==', [-name => qw/me.name/], [-value => '100' ] ]
+      ]
+  ]
+), "WHERE me.id > ? OR me.name = ? OR me.name = ?", "where clause";
+
+is SQL::Abstract->generate(
+  [ -where =>  -or =>
+      [ '==', [-name => qw/me.id/], [-value => 500 ] ],
+      [ -and => 
+        [ '>', [-name => qw/me.name/], [-value => '200' ] ],
+        [ '<', [-name => qw/me.name/], [-value => '100' ] ]
+      ]
+  ]
+), "WHERE me.id = ? OR (me.name > ? AND me.name < ?)", "where clause";