X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FAbstract%2FTree.pm;h=02de4d9ae53ef1d2a0e17d36a153ea6d07659f36;hb=9f7f28c4d2eccc1b5fe0280577ad73d82916ac5d;hp=7b97b296b1698c1dbdcc5ae43e1741aba83d81af;hpb=b3b79607321d406a194b2aac205978d925b398c0;p=scpubgit%2FQ-Branch.git diff --git a/lib/SQL/Abstract/Tree.pm b/lib/SQL/Abstract/Tree.pm index 7b97b29..02de4d9 100644 --- a/lib/SQL/Abstract/Tree.pm +++ b/lib/SQL/Abstract/Tree.pm @@ -40,6 +40,8 @@ my $op_look_behind = '(?: (?<= [\,\s\)\(] ) | \A )'; my $quote_left = qr/[\`\'\"\[]/; my $quote_right = qr/[\`\'\"\]]/; +my $placeholder_re = qr/(?: \? | \$\d+ )/x; + # These SQL keywords always signal end of the current expression (except inside # of a parenthesized subexpression). # Format: A list of strings that will be compiled to extended syntax ie. @@ -61,7 +63,7 @@ my @expression_start_keywords = ( )', 'ON', 'WHERE', - 'VALUES', + '(?: DEFAULT \s+ )? VALUES', 'EXISTS', 'GROUP \s+ BY', 'HAVING', @@ -114,6 +116,7 @@ my $all_known_re = join("\n\t|\n", $binary_op_re, "$op_look_behind (?i: AND|OR|NOT ) $op_look_ahead", (map { quotemeta $_ } qw/, ( ) */), + $placeholder_re, ); $all_known_re = qr/$all_known_re/x; @@ -131,7 +134,7 @@ use constant PARSE_RHS => 4; my $expr_term_re = qr/ ^ (?: $expr_start_re | \) ) $/x; my $rhs_term_re = qr/ ^ (?: $expr_term_re | $binary_op_re | (?i: AND | OR | NOT | \, ) ) $/x; -my $func_start_re = qr/^ (?: \? | \$\d+ | \( ) $/x; +my $func_start_re = qr/^ (?: \* | $placeholder_re | \( ) $/x; my %indents = ( select => 0, @@ -315,8 +318,8 @@ sub _recurse_parse { elsif ( $token =~ / ^ $expr_start_re $ /x ) { my $op = uc $token; my $right = $self->_recurse_parse($tokens, PARSE_IN_EXPR); - $left = $left ? [ $left, [$op => [$right] ]] - : [ $op => [$right] ]; + $left = $left ? [ $left, [$op => [$right||()] ]] + : [ $op => [$right||()] ]; } # NOT elsif ( $token =~ /^ NOT $/ix ) { @@ -326,6 +329,10 @@ sub _recurse_parse { : [ $op => [$right] ]; } + elsif ( $token =~ $placeholder_re) { + $left = $left ? [ $left, [ PLACEHOLDER => [ $token ] ] ] + : [ PLACEHOLDER => [ $token ] ]; + } # we're now in "unknown token" land - start eating tokens until # we see something familiar else { @@ -370,7 +377,7 @@ sub pad_keyword { $before = $self->newline . $self->indent($depth + $self->indentmap->{lc $keyword}); } $before = '' if $depth == 0 and defined $starters{lc $keyword}; - return [$before, ' ']; + return [$before, '']; } sub indent { ($_[0]->indent_string||'') x ( ( $_[0]->indent_amount || 0 ) * $_[1] ) } @@ -395,10 +402,14 @@ sub fill_in_placeholder { return '?' } +# FIXME - terrible name for a user facing API sub unparse { - my ($self, $tree, $bindargs, $depth) = @_; + my ($self, $tree, $bindargs) = @_; + $self->_unparse($tree, [@{$bindargs||[]}], 0); +} - $depth ||= 0; +sub _unparse { + my ($self, $tree, $bindargs, $depth) = @_; if (not $tree or not @$tree) { return ''; @@ -414,29 +425,33 @@ sub unparse { } if (ref $car) { - return join (' ', map $self->unparse($_, $bindargs, $depth), @$tree); + return join (' ', map $self->_unparse($_, $bindargs, $depth), @$tree); } elsif ($car eq 'LITERAL') { - if ($cdr->[0] eq '?') { - return $self->fill_in_placeholder($bindargs) - } return $cdr->[0]; } + elsif ($car eq 'PLACEHOLDER') { + return $self->fill_in_placeholder($bindargs); + } elsif ($car eq 'PAREN') { - return '(' . - join(' ', - map $self->unparse($_, $bindargs, $depth + 2), @{$cdr}) . - ($self->_is_key($cdr)?( $self->newline||'' ).$self->indent($depth + 1):'') . ') '; + return sprintf ('(%s)', + join (' ', map { $self->_unparse($_, $bindargs, $depth + 2) } @{$cdr} ) + . + ($self->_is_key($cdr) + ? ( $self->newline||'' ) . $self->indent($depth + 1) + : '' + ) + ); } elsif ($car eq 'AND' or $car eq 'OR' or $car =~ / ^ $binary_op_re $ /x ) { - return join (" $car ", map $self->unparse($_, $bindargs, $depth), @{$cdr}); + return join (" $car ", map $self->_unparse($_, $bindargs, $depth), @{$cdr}); } elsif ($car eq 'LIST' ) { - return join (', ', map $self->unparse($_, $bindargs, $depth), @{$cdr}); + return join (', ', map $self->_unparse($_, $bindargs, $depth), @{$cdr}); } 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$r", $self->format_keyword($car), $self->_unparse($cdr, $bindargs, $depth); } }