X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FAbstract%2FTree.pm;h=81a360d24df2a5e36ab30c8ef71d99b943fdc08d;hb=0c2de280869928d9ff1ee95f36a9a45318766990;hp=7ee5c44baec5b2150d6bbda162e85d04dce59ed8;hpb=90d0250b5e73134c398877cf8cf3f4afef917cdf;p=dbsrgits%2FSQL-Abstract.git

diff --git a/lib/SQL/Abstract/Tree.pm b/lib/SQL/Abstract/Tree.pm
index 7ee5c44..81a360d 100644
--- a/lib/SQL/Abstract/Tree.pm
+++ b/lib/SQL/Abstract/Tree.pm
@@ -99,7 +99,7 @@ $expr_start_re = qr/ $op_look_behind (?i: $expr_start_re ) $op_look_ahead /x;
 # this will be included in the $binary_op_re, the distinction is interesting during
 # testing as one is tighter than the other, plus mathops have different look
 # ahead/behind (e.g. "x"="y" )
-my @math_op_keywords = (qw/ < > != <> = <= >= /);
+my @math_op_keywords = (qw/ - + < > != <> = <= >= /);
 my $math_op_re = join ("\n\t|\n", map
   { "(?: (?<= [\\w\\s] | $quote_right ) | \\A )"  . quotemeta ($_) . "(?: (?= [\\w\\s] | $quote_left ) | \\z )" }
   @math_op_keywords
@@ -590,6 +590,10 @@ sub _unparse {
   elsif ($op eq '-MISC' ) {
     return join (' ', map $self->_unparse($_, $bindargs, $depth), @{$args});
   }
+  elsif ($op =~ qr/^-(ASC|DESC)$/ ) {
+    my $dir = $1;
+    return join (' ', (map $self->_unparse($_, $bindargs, $depth), @{$args}), $dir);
+  }
   else {
     my ($l, $r) = @{$self->pad_keyword($op, $depth)};
     return sprintf "$l%s%s%s$r",
@@ -727,6 +731,23 @@ sub _parenthesis_unroll {
         $changes++;
       }
 
+      # a construct of ... ( somefunc ( ... ) ) ... can safely lose the outer parens
+      # except for the case of ( NOT ( ... ) ) which has already been handled earlier
+      elsif (
+        @{$child->[1]} == 1
+          and
+        @{$child->[1][0][1]} == 1
+          and
+        $child->[1][0][0] ne 'NOT'
+          and
+        ref $child->[1][0][1][0] eq 'ARRAY'
+          and
+        $child->[1][0][1][0][0] eq '-PAREN'
+      ) {
+        push @children, @{$child->[1]};
+        $changes++;
+      }
+
 
       # otherwise no more mucking for this pass
       else {
@@ -739,6 +760,30 @@ sub _parenthesis_unroll {
   } while ($changes);
 }
 
+sub _strip_asc_from_order_by {
+  my ($self, $ast) = @_;
+
+  return $ast if (
+    ref $ast ne 'ARRAY'
+      or
+    $ast->[0] ne 'ORDER BY'
+  );
+
+
+  my $to_replace;
+
+  if (@{$ast->[1]} == 1 and $ast->[1][0][0] eq '-ASC') {
+    $to_replace = [ $ast->[1][0] ];
+  }
+  elsif (@{$ast->[1]} == 1 and $ast->[1][0][0] eq '-LIST') {
+    $to_replace = [ grep { $_->[0] eq '-ASC' } @{$ast->[1][0][1]} ];
+  }
+
+  @$_ = @{$_->[1][0]} for @$to_replace;
+
+  $ast;
+}
+
 sub format { my $self = shift; $self->unparse($self->parse($_[0]), $_[1]) }
 
 1;