fix SQLATest, add more rudimentary formatting and some depth
Arthur Axel "fREW" Schmidt [Thu, 2 Sep 2010 03:08:36 +0000 (03:08 +0000)]
lib/SQL/Abstract/Test.pm
lib/SQL/Abstract/Tree.pm
t/11unparse.t

index 93854d0..c511eee 100644 (file)
@@ -11,6 +11,8 @@ our @EXPORT_OK = qw/&is_same_sql_bind &is_same_sql &is_same_bind
                     &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 @@ sub eq_sql {
   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 @@ sub _eq_sql {
   }
   # 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 @@ sub _eq_sql {
     # 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 @@ sub _eq_sql {
       }
       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 _parenthesis_unroll {
 
 }
 
-sub parse { goto &SQL::Abstract::Tree::parse }
-
-sub unparse { goto &SQL::Abstract::Tree::unparse  }
-
-
 1;
 
 
index 46c0b42..7c207c2 100644 (file)
@@ -183,26 +183,48 @@ sub format_keyword {
   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);
   }
 }
 
index 1b07526..a865416 100644 (file)
@@ -19,6 +19,13 @@ my $sqlat = SQL::Abstract::Tree->new;
    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