Leave quotes from DBIC in bindargs

[dbsrgits/SQL-Abstract.git] / lib / SQL / Abstract / Tree.pm

diff --git a/lib/SQL/Abstract/Tree.pm b/lib/SQL/Abstract/Tree.pm
index e3eba08..0cceed8 100644 (file)
--- a/lib/SQL/Abstract/Tree.pm
+++ b/lib/SQL/Abstract/Tree.pm
@@ -154,6 +154,7 @@ my %indents = (
    join          => 1,
    'left join'   => 1,
    on            => 2,
+   having        => 0,
    'group by'    => 0,
    'order by'    => 0,
    set           => 1,
@@ -187,7 +188,7 @@ my %profiles = (
           my $magenta = [$c->('magenta'), $c->('reset')];
           my $b_o_w   = [$c->('black on_white'), $c->('reset')];
           (
-            placeholder_surround => [q(') . $c->('black on_magenta'), $c->('reset') . q(')],
+            placeholder_surround => [$c->('black on_magenta'), $c->('reset')],
             colormap => {
               'begin work'            => $b_o_w,
               commit                  => $b_o_w,
@@ -212,6 +213,7 @@ my %profiles = (
               on                      => $blue,
 
               'group by'              => $yellow,
+              having                  => $yellow,
               'order by'              => $yellow,
 
               skip                    => $green,
@@ -254,6 +256,7 @@ my %profiles = (
          on            => ['<span class="on">'      , '</span>'],
 
          'group by'    => ['<span class="group-by">', '</span>'],
+         having        => ['<span class="having">',   '</span>'],
          'order by'    => ['<span class="order-by">', '</span>'],
 
          skip          => ['<span class="skip">',   '</span>'],
@@ -281,6 +284,9 @@ sub new {
    my $args  = shift || {};
 
    my $profile = delete $args->{profile} || 'none';
+
+   die "No such profile '$profile'!" unless exists $profiles{$profile};
+
    my $data = $merger->merge( $profiles{$profile}, $args );
 
    bless $data, $class
@@ -442,10 +448,12 @@ sub fill_in_placeholder {
 
    if ($self->fill_in_placeholders) {
       my $val = shift @{$bindargs} || '';
+      $val =~ s/^(')(.*)(')$/$2/;
+      my ($lquo, $rquo) = ($1 || '', $3 || '');
       my ($left, $right) = @{$self->placeholder_surround};
       $val =~ s/\\/\\\\/g;
       $val =~ s/'/\\'/g;
-      return qq($left$val$right)
+      return qq($left$lquo$val$rquo$right)
    }
    return '?'
 }
@@ -482,7 +490,7 @@ sub _unparse {
     return $self->fill_in_placeholder($bindargs);
   }
   elsif ($car eq 'PAREN') {
-    return sprintf ('(%s)',
+    return sprintf ('( %s )',
       join (' ', map { $self->_unparse($_, $bindargs, $depth + 2) } @{$cdr} )
         .
       ($self->_is_key($cdr)
@@ -499,7 +507,15 @@ sub _unparse {
   }
   else {
     my ($l, $r) = @{$self->pad_keyword($car, $depth)};
-    return sprintf "$l%s %s$r", $self->format_keyword($car), $self->_unparse($cdr, $bindargs, $depth);
+
+    return sprintf "$l%s%s%s$r",
+      $self->format_keyword($car),
+      ( ref $cdr eq 'ARRAY' and ref $cdr->[0] eq 'ARRAY' and $cdr->[0][0] and $cdr->[0][0] eq 'PAREN' )
+        ? ''    # mysql--
+        : ' '
+      ,
+      $self->_unparse($cdr, $bindargs, $depth),
+    ;
   }
 }
 
@@ -509,6 +525,10 @@ sub format { my $self = shift; $self->unparse($self->parse($_[0]), $_[1]) }
 
 =pod
 
+=head1 NAME
+
+SQL::Abstract::Tree - Represent SQL as an AST
+
 =head1 SYNOPSIS
 
  my $sqla_tree = SQL::Abstract::Tree->new({ profile => 'console' });