[Bast-commits] r5206 - in SQL-Abstract/1.x/branches/1.50_RC-extraparens: . lib/SQL/Abstract t

[norbi at dev.catalyst.perl.org]

Author: norbi
Date: 2008-11-26 21:03:25 +0000 (Wed, 26 Nov 2008)
New Revision: 5206

Modified:
   SQL-Abstract/1.x/branches/1.50_RC-extraparens/
   SQL-Abstract/1.x/branches/1.50_RC-extraparens/lib/SQL/Abstract/Test.pm
   SQL-Abstract/1.x/branches/1.50_RC-extraparens/t/10test.t
Log:
 r5261 at vger:  mendel | 2008-11-26 20:51:10 +0100
  * eq_sql now detects expressions in the 'ON', 'WHERE', ... clauses of SQL statements even if there are no surrounding parentheses. The code is still ugly, a number of test cases are missing and probably chokes on subselects.



Property changes on: SQL-Abstract/1.x/branches/1.50_RC-extraparens
___________________________________________________________________
Name: svk:merge
   - 4d5fae46-8e6a-4e08-abee-817e9fb894a2:/local/bast/SQL-Abstract/1.x/branches/1.50_RC:5202
4d5fae46-8e6a-4e08-abee-817e9fb894a2:/local/bast/SQL-Abstract/1.x/branches/1.50_RC-extraparens:5240
   + 4d5fae46-8e6a-4e08-abee-817e9fb894a2:/local/bast/SQL-Abstract/1.x/branches/1.50_RC:5202
4d5fae46-8e6a-4e08-abee-817e9fb894a2:/local/bast/SQL-Abstract/1.x/branches/1.50_RC-extraparens:5261

Modified: SQL-Abstract/1.x/branches/1.50_RC-extraparens/lib/SQL/Abstract/Test.pm
===================================================================
--- SQL-Abstract/1.x/branches/1.50_RC-extraparens/lib/SQL/Abstract/Test.pm	2008-11-26 19:24:14 UTC (rev 5205)
+++ SQL-Abstract/1.x/branches/1.50_RC-extraparens/lib/SQL/Abstract/Test.pm	2008-11-26 21:03:25 UTC (rev 5206)
@@ -72,7 +72,6 @@
   # parse
   my $tree1 = parse($sql1);
   my $tree2 = parse($sql2);
-  warn Dumper($tree1, $tree2);  #FIXME debug
 
   return _eq_sql($tree1, $tree2);
 }
@@ -134,8 +133,8 @@
       |
         \b WHERE \b
       |
-        \b GROUP\sBY \b
-        \b ORDER\sBY \b
+        \b GROUP \s+ BY \b
+        \b ORDER \s+ BY \b
         \b LIMIT \b
         \b OFFSET \b
     )
@@ -154,19 +153,22 @@
 }
 
 sub _recurse_parse {
-  my $tokens = shift;
+  my ($tokens, $delimiters) = @_;
 
+  $delimiters ||= [];
+
   my $left;
   while (1) { # left-associative parsing
 
     my $lookahead = $tokens->[0];
-    return $left if !defined($lookahead) || $lookahead eq ')';
+    return $left if !defined($lookahead)
+      || grep { $lookahead =~ /^$_$/i } @$delimiters;
 
     my $token = shift @$tokens;
 
     # nested expression in ()
     if ($token eq '(') {
-      my $right = _recurse_parse($tokens);
+      my $right = _recurse_parse($tokens, ['\)']);
       $token = shift @$tokens   or croak "missing ')'";
       $token eq ')'             or croak "unexpected token : $token";
       $left = $left ? [CONCAT => [$left, [PAREN => $right]]]
@@ -174,13 +176,19 @@
     }
     # AND/OR
     elsif ($token eq 'AND' || $token eq 'OR')  {
-      my $right = _recurse_parse($tokens);
+      my $right = _recurse_parse($tokens, 
+        ['\)', '(((LEFT|RIGHT|FULL)\s+)?(CROSS|INNER|OUTER)\s+)?JOIN',
+         'WHERE', 'GROUP\s+BY', 'ORDER\s+BY', 'LIMIT', 'OFFSET']
+      );
       $left = [$token => [$left, $right]];
     }
     # ON, WHERE, GROUP BY, ORDER BY, LIMIT, OFFSET
-    elsif (grep { $token eq $_ }
-      ('ON', 'WHERE', 'GROUP BY', 'ORDER BY', 'LIMIT', 'OFFSET')) {
-      my $right = _recurse_parse($tokens);
+    elsif (grep { $token =~ /^$_$/i }
+      ('ON', 'WHERE', 'GROUP\s+BY', 'ORDER\s+BY', 'LIMIT', 'OFFSET')) {
+      my $right = _recurse_parse($tokens, 
+        ['\)', '(((LEFT|RIGHT|FULL)\s+)?(CROSS|INNER|OUTER)\s+)?JOIN',
+         'WHERE', 'GROUP\s+BY', 'ORDER\s+BY', 'LIMIT', 'OFFSET']
+      );
       $left = $left ? [CONCAT => [$left, [CONCAT => [[EXPR => $token], [PAREN => $right]]]]]
                     : [CONCAT => [[EXPR => $token], [PAREN  => $right]]];
     }

Modified: SQL-Abstract/1.x/branches/1.50_RC-extraparens/t/10test.t
===================================================================
--- SQL-Abstract/1.x/branches/1.50_RC-extraparens/t/10test.t	2008-11-26 19:24:14 UTC (rev 5205)
+++ SQL-Abstract/1.x/branches/1.50_RC-extraparens/t/10test.t	2008-11-26 21:03:25 UTC (rev 5206)
@@ -117,6 +117,7 @@
           q/SELECT foo FROM bar JOIN quux ON b = foo WHERE a = 1/,
           q/SELECT foo FROM bar JOIN quux ON (c = foo) WHERE a = 1/,
           q/SELECT foo FROM bar WHERE (c = 1)/,
+          q/SELECT foo FROM bar WHERE (d = 1)/,
         ]
       },
       {
@@ -137,6 +138,7 @@
           q/SELECT foo FROM bar JOIN quux WHERE a = 1 AND b = 1/,
           q/SELECT foo FROM bar JOIN quux ON b = foo WHERE a = 1 AND b = 1/,
           q/SELECT foo FROM bar JOIN quux ON (c = foo) WHERE a = 1 AND b = 1/,
+          q/SELECT foo FROM bar JOIN quux ON (d = foo) WHERE a = 1 AND b = 1/,
         ]
       },