From: Peter Rabbitson Date: Thu, 4 Feb 2010 13:23:16 +0000 (+0000) Subject: Things look saner now X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b9a4fdaeeb2cc0b566968a740fd9063a095ade07;p=scpubgit%2FQ-Branch.git Things look saner now --- diff --git a/Changes b/Changes index 14e1bac..e546749 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,7 @@ Revision history for SQL::Abstract + - Another iteration of SQL::Abstract::Test fixes and improvements + revision 1.60 2009-09-22 11:03 (UTC) ---------------------------- - fix a well masked error in the sql-test tokenizer diff --git a/lib/SQL/Abstract/Test.pm b/lib/SQL/Abstract/Test.pm index be82511..8951e36 100644 --- a/lib/SQL/Abstract/Test.pm +++ b/lib/SQL/Abstract/Test.pm @@ -40,6 +40,7 @@ my @expression_terminator_sql_keywords = ( )', 'ON', 'WHERE', + 'EXISTS', 'GROUP \s+ BY', 'HAVING', 'ORDER \s+ BY', @@ -58,11 +59,14 @@ my @expression_terminator_sql_keywords = ( # * BETWEEN without paranthesis around the ANDed arguments (which # makes it a non-binary op) is detected and accomodated in # _recurse_parse() -my $stuff_around_mathops = qr/[\w\s\`\'\)]/; +my $stuff_around_mathops = qr/[\w\s\`\'\"\)]/; my @binary_op_keywords = ( ( map - { " (?<= $stuff_around_mathops) " . quotemeta $_ . "(?= $stuff_around_mathops )" } - (qw/< > != = <= >=/) + { + ' ^ ' . quotemeta ($_) . "(?= \$ | $stuff_around_mathops ) ", + " (?<= $stuff_around_mathops)" . quotemeta ($_) . "(?= \$ | $stuff_around_mathops ) ", + } + (qw/< > != <> = <= >=/) ), ( map { '\b (?: NOT \s+)?' . $_ . '\b' } @@ -75,7 +79,7 @@ my $tokenizer_re_str = join("\n\t|\n", @binary_op_keywords, ); -my $tokenizer_re = qr/ \s* ( \( | \) | \? | $tokenizer_re_str ) \s* /xi; +my $tokenizer_re = qr/ \s* ( $tokenizer_re_str | \( | \) | \? ) \s* /xi; # All of these keywords allow their parameters to be specified with or without parenthesis without changing the semantics my @unrollable_ops = ( @@ -216,7 +220,7 @@ sub _eq_sql { _parenthesis_unroll ($_) for ($left, $right); # if operators are different - if ($left->[0] ne $right->[0]) { + if ( $left->[0] ne $right->[0] ) { $sql_differ = sprintf "OP [$left->[0]] != [$right->[0]] in\nleft: %s\nright: %s\n", unparse($left), unparse($right); @@ -224,7 +228,7 @@ sub _eq_sql { } # elsif operators are identical, compare operands else { - if ($left->[0] eq 'EXPR' ) { # unary operator + if ($left->[0] eq 'LITERAL' ) { # unary (my $l = " $left->[1][0] " ) =~ s/\s+/ /g; (my $r = " $right->[1][0] ") =~ s/\s+/ /g; my $eq = $case_sensitive ? $l eq $r : uc($l) eq uc($r); @@ -246,10 +250,7 @@ sub parse { # tokenize string, and remove all optional whitespace my $tokens = []; foreach my $token (split $tokenizer_re, $s) { - $token =~ s/\s+/ /g; - $token =~ s/\s+([^\w\s])/$1/g; - $token =~ s/([^\w\s])\s+/$1/g; - push @$tokens, $token if length $token; + push @$tokens, $token if (length $token) && ($token =~ /\S/); } my $tree = _recurse_parse($tokens, PARSE_TOP_LEVEL); @@ -277,7 +278,7 @@ sub _recurse_parse { my $token = shift @$tokens; # nested expression in () - if ($token eq '(') { + if ($token eq '(' ) { my $right = _recurse_parse($tokens, PARSE_IN_PARENS); $token = shift @$tokens or croak "missing closing ')' around block " . unparse ($right); $token eq ')' or croak "unexpected token '$token' terminating block " . unparse ($right); @@ -302,9 +303,9 @@ sub _recurse_parse { my $op = uc $token; my $right = _recurse_parse($tokens, PARSE_RHS); - # A between with a simple EXPR for a 1st RHS argument needs a + # A between with a simple LITERAL for a 1st RHS argument needs a # rerun of the search to (hopefully) find the proper AND construct - if ($op eq 'BETWEEN' and $right->[0] eq 'EXPR') { + if ($op eq 'BETWEEN' and $right->[0] eq 'LITERAL') { unshift @$tokens, $right->[1][0]; $right = _recurse_parse($tokens, PARSE_IN_EXPR); } @@ -326,10 +327,11 @@ sub _recurse_parse { : [[ $op => [$right] ]]; } - # leaf expression + # literal (eat everything on the right until RHS termination) else { - $left = $left ? [@$left, [EXPR => [$token] ] ] - : [ EXPR => [$token] ]; + my $right = _recurse_parse ($tokens, PARSE_RHS); + $left = $left ? [$left, [LITERAL => [join ' ', $token, unparse($right)||()] ] ] + : [ LITERAL => [join ' ', $token, unparse($right)||()] ]; } } } @@ -373,23 +375,23 @@ sub _parenthesis_unroll { $changes++; } - # only one EXPR element in the parenthesis + # only one LITERAL element in the parenthesis elsif ( - @{$child->[1]} == 1 && $child->[1][0][0] eq 'EXPR' + @{$child->[1]} == 1 && $child->[1][0][0] eq 'LITERAL' ) { push @children, $child->[1][0]; $changes++; } - # only one element in the parenthesis which is a binary op with two EXPR sub-children + # only one element in the parenthesis which is a binary op with two LITERAL sub-children elsif ( @{$child->[1]} == 1 and grep { $child->[1][0][0] =~ /^ $_ $/xi } (@binary_op_keywords) and - $child->[1][0][1][0][0] eq 'EXPR' + $child->[1][0][1][0][0] eq 'LITERAL' and - $child->[1][0][1][1][0] eq 'EXPR' + $child->[1][0][1][1][0] eq 'LITERAL' ) { push @children, $child->[1][0]; $changes++; @@ -416,7 +418,7 @@ sub unparse { elsif (ref $tree->[0]) { return join (" ", map { unparse ($_) } @$tree); } - elsif ($tree->[0] eq 'EXPR') { + elsif ($tree->[0] eq 'LITERAL') { return $tree->[1][0]; } elsif ($tree->[0] eq 'PAREN') { diff --git a/t/05in_between.t b/t/05in_between.t index aa0b13a..bf32375 100644 --- a/t/05in_between.t +++ b/t/05in_between.t @@ -101,14 +101,14 @@ my @in_between_tests = ( { parenthesis_significant => 1, where => { x => { -in => \'( 1,2,lower(y) )' } }, - stmt => "WHERE ( x IN (1, 2, lower(y) ) )", + stmt => "WHERE ( x IN ( 1,2,lower(y) ) )", bind => [], test => '-in with a literal scalarref', }, { parenthesis_significant => 1, where => { x => { -in => \['( ( ?,?,lower(y) ) )', 1, 2] } }, - stmt => "WHERE ( x IN (?, ?, lower(y) ) )", + stmt => "WHERE ( x IN ( ?,?,lower(y) ) )", # note that outer parens are opened even though literal was requested (RIBASUSHI) bind => [1, 2], test => '-in with a literal arrayrefref', }, diff --git a/t/07subqueries.t b/t/07subqueries.t index d0564aa..f14738a 100644 --- a/t/07subqueries.t +++ b/t/07subqueries.t @@ -35,7 +35,7 @@ $where = { }; push @tests, { where => $where, - stmt => " WHERE ( bar > ALL (SELECT c1 FROM t1 WHERE ( c2 < ? AND c3 LIKE ? )) AND foo = ? )", + stmt => " WHERE ( bar > ALL (SELECT c1 FROM t1 WHERE (( c2 < ? AND c3 LIKE ? )) ) AND foo = ? )", bind => [100, "foo%", 1234], };