[Bast-commits] r9669 - in SQL-Abstract/1.x/branches/sqla-tree: lib/SQL/Abstract t

frew at dev.catalyst.perl.org frew at dev.catalyst.perl.org
Thu Sep 2 03:08:36 GMT 2010


Author: frew
Date: 2010-09-02 04:08:36 +0100 (Thu, 02 Sep 2010)
New Revision: 9669

Modified:
   SQL-Abstract/1.x/branches/sqla-tree/lib/SQL/Abstract/Test.pm
   SQL-Abstract/1.x/branches/sqla-tree/lib/SQL/Abstract/Tree.pm
   SQL-Abstract/1.x/branches/sqla-tree/t/11unparse.t
Log:
fix SQLATest, add more rudimentary formatting and some depth

Modified: SQL-Abstract/1.x/branches/sqla-tree/lib/SQL/Abstract/Test.pm
===================================================================
--- SQL-Abstract/1.x/branches/sqla-tree/lib/SQL/Abstract/Test.pm	2010-09-01 21:05:35 UTC (rev 9668)
+++ SQL-Abstract/1.x/branches/sqla-tree/lib/SQL/Abstract/Test.pm	2010-09-02 03:08:36 UTC (rev 9669)
@@ -11,6 +11,8 @@
                     &eq_sql_bind &eq_sql &eq_bind
                     $case_sensitive $sql_differ/;
 
+my $sqlat = SQL::Abstract::Tree->new;
+
 our $case_sensitive = 0;
 our $parenthesis_significant = 0;
 our $sql_differ; # keeps track of differing portion between SQLs
@@ -122,8 +124,8 @@
   my ($sql1, $sql2) = @_;
 
   # parse
-  my $tree1 = parse($sql1);
-  my $tree2 = parse($sql2);
+  my $tree1 = $sqlat->parse($sql1);
+  my $tree2 = $sqlat->parse($sql2);
 
   return 1 if _eq_sql($tree1, $tree2);
 }
@@ -141,7 +143,7 @@
   }
   # one is a list, the other is an op with a list
   elsif (ref $left->[0] xor ref $right->[0]) {
-    $sql_differ = sprintf ("left: %s\nright: %s\n", map { unparse ($_) } ($left, $right) );
+    $sql_differ = sprintf ("left: %s\nright: %s\n", map { $sqlat->unparse ($_) } ($left, $right) );
     return 0;
   }
   # one is a list, so is the other
@@ -160,8 +162,8 @@
     # if operators are different
     if ( $left->[0] ne $right->[0] ) {
       $sql_differ = sprintf "OP [$left->[0]] != [$right->[0]] in\nleft: %s\nright: %s\n",
-        unparse($left),
-        unparse($right);
+        $sqlat->unparse($left),
+        $sqlat->unparse($right);
       return 0;
     }
     # elsif operators are identical, compare operands
@@ -175,7 +177,7 @@
       }
       else {
         my $eq = _eq_sql($left->[1], $right->[1]);
-        $sql_differ ||= sprintf ("left: %s\nright: %s\n", map { unparse ($_) } ($left, $right) ) if not $eq;
+        $sql_differ ||= sprintf ("left: %s\nright: %s\n", map { $sqlat->unparse ($_) } ($left, $right) ) if not $eq;
         return $eq;
       }
     }
@@ -255,11 +257,6 @@
 
 }
 
-sub parse { goto &SQL::Abstract::Tree::parse }
-
-sub unparse { goto &SQL::Abstract::Tree::unparse  }
-
-
 1;
 
 

Modified: SQL-Abstract/1.x/branches/sqla-tree/lib/SQL/Abstract/Tree.pm
===================================================================
--- SQL-Abstract/1.x/branches/sqla-tree/lib/SQL/Abstract/Tree.pm	2010-09-01 21:05:35 UTC (rev 9668)
+++ SQL-Abstract/1.x/branches/sqla-tree/lib/SQL/Abstract/Tree.pm	2010-09-02 03:08:36 UTC (rev 9669)
@@ -183,26 +183,48 @@
   return $keyword
 }
 
+sub whitespace {
+   my ($self, $keyword, $depth) = @_;
+   if (lc $keyword eq 'from') {
+      return ['', "\n"];
+   }
+   return ['', ''];
+}
+
+sub newline { "\n" }
+
+sub indent { '   ' x $_[1] }
+
 sub unparse {
-  my ($self, $tree) = @_;
+  my ($self, $tree, $depth) = @_;
 
+  $depth ||= 1;
+
   if (not $tree ) {
     return '';
   }
-  elsif (ref $tree->[0]) {
-    return join (" ", map $self->unparse ($_), @$tree);
+
+  my $car = $tree->[0];
+  my $cdr = $tree->[1];
+
+  if (ref $car) {
+    return join (" ", map $self->unparse($_), @$tree);
   }
-  elsif ($tree->[0] eq 'LITERAL') {
-    return $tree->[1][0];
+  elsif ($car eq 'LITERAL') {
+    return $cdr->[0];
   }
-  elsif ($tree->[0] eq 'PAREN') {
-    return sprintf '(%s)', join (" ", map $self->unparse($_), @{$tree->[1]});
+  elsif ($car eq 'PAREN') {
+    return '(' . $self->newline .
+      join(' ',
+        map $self->indent($depth) . $self->unparse($_, $depth + 1), @{$cdr})
+    . $self->newline . ')';
   }
-  elsif ($tree->[0] eq 'OR' or $tree->[0] eq 'AND' or (grep { $tree->[0] =~ /^ $_ $/xi } @binary_op_keywords ) ) {
-    return join (" $tree->[0] ", map $self->unparse($_), @{$tree->[1]});
+  elsif ($car eq 'OR' or $car eq 'AND' or (grep { $car =~ /^ $_ $/xi } @binary_op_keywords ) ) {
+    return join (" $car ", map $self->unparse($_), @{$cdr});
   }
   else {
-    return sprintf '%s %s', $self->format_keyword($tree->[0]), $self->unparse ($tree->[1]);
+    my ($l, $r) = @{$self->whitespace($car, $depth)};
+    return sprintf "%s %s$r", $self->format_keyword($car), $self->unparse($cdr);
   }
 }
 

Modified: SQL-Abstract/1.x/branches/sqla-tree/t/11unparse.t
===================================================================
--- SQL-Abstract/1.x/branches/sqla-tree/t/11unparse.t	2010-09-01 21:05:35 UTC (rev 9668)
+++ SQL-Abstract/1.x/branches/sqla-tree/t/11unparse.t	2010-09-02 03:08:36 UTC (rev 9669)
@@ -19,6 +19,13 @@
    print $sqlat->format($sql) . "\n";
 }
 
+{
+   my $sql = "SELECT * FROM lolz WHERE ( foo.a =1 ) and foo.b LIKE 'station'";
+
+   print "$sql\n";
+   print $sqlat->format($sql) . "\n";
+}
+
 # stuff we want:
 #    Nested indentation
 #    Max Width




More information about the Bast-commits mailing list