From 1b0e195b127a09e72d832c48de332bab90dbb41f Mon Sep 17 00:00:00 2001 From: Diab Jerius Date: Fri, 1 Aug 2025 11:58:06 -0400 Subject: [PATCH 1/2] add "quoted" version of all tests in 01-sql_abstract_more_quoted.t change from double to single quotes in 01-sql_abstract_more_quoted.t to make it easier to compare with 08-sql_abstract_more_quoted.t add test for literal sql in joins with using() add test for CTE --- t/01-sql_abstract_more.t | 324 ++++---- t/08-sql_abstract_more_quoted.t | 1253 +++++++++++++++++++++++++++++++ 2 files changed, 1443 insertions(+), 134 deletions(-) create mode 100644 t/08-sql_abstract_more_quoted.t diff --git a/t/01-sql_abstract_more.t b/t/01-sql_abstract_more.t index bdf88bc..12c1603 100644 --- a/t/01-sql_abstract_more.t +++ b/t/01-sql_abstract_more.t @@ -23,37 +23,37 @@ my ($sql, @bind, $join); #---------------------------------------------------------------------- # old API transmitted to parent -($sql, @bind) = $sqla->select('Foo', 'bar', {bar => {">" => 123}}, ['bar']); +($sql, @bind) = $sqla->select('Foo', 'bar', {bar => {'>' => 123}}, ['bar']); is_same_sql_bind( $sql, \@bind, - "SELECT bar FROM Foo WHERE bar > ? ORDER BY bar", [123], - "old API (positional parameters)", + 'SELECT bar FROM Foo WHERE bar > ? ORDER BY bar', [123], + 'old API (positional parameters)', ); # idem, new API ($sql, @bind) = $sqla->select( -columns => [qw/bar/], -from => 'Foo', - -where => {bar => {">" => 123}}, + -where => {bar => {'>' => 123}}, -order_by => ['bar'] ); is_same_sql_bind( $sql, \@bind, - "SELECT bar FROM Foo WHERE bar > ? ORDER BY bar", [123], - "new API : named parameters", + 'SELECT bar FROM Foo WHERE bar > ? ORDER BY bar', [123], + 'new API : named parameters', ); # pass one table as array ($sql, @bind) = $sqla->select( -columns => [qw/bar/], -from => ['Foo'], - -where => {bar => {">" => 123}}, + -where => {bar => {'>' => 123}}, -order_by => ['bar'] ); is_same_sql_bind( $sql, \@bind, - "SELECT bar FROM Foo WHERE bar > ? ORDER BY bar", [123], - "-from => arrayref (1 table)", + 'SELECT bar FROM Foo WHERE bar > ? ORDER BY bar', [123], + '-from => arrayref (1 table)', ); @@ -61,24 +61,24 @@ is_same_sql_bind( ($sql, @bind) = $sqla->select( -columns => [qw/bar/], -from => [qw/Foo Bar Buz/], - -where => {bar => {">" => 123}}, + -where => {bar => {'>' => 123}}, ); is_same_sql_bind( $sql, \@bind, - "SELECT bar FROM Foo, Bar, Buz WHERE bar > ?", [123], - "-from => arrayref (several tables)", + 'SELECT bar FROM Foo, Bar, Buz WHERE bar > ?', [123], + '-from => arrayref (several tables)', ); ($sql, @bind) = $sqla->select( -columns => [qw/bar/], -from => \ 'Foo', - -where => {bar => {">" => 123}}, + -where => {bar => {'>' => 123}}, ); is_same_sql_bind( $sql, \@bind, - "SELECT bar FROM Foo WHERE bar > ?", [123], - "-from => scalarref", + 'SELECT bar FROM Foo WHERE bar > ?', [123], + '-from => scalarref', ); @@ -86,12 +86,12 @@ is_same_sql_bind( ($sql, @bind) = $sqla->select( -columns => [qw/bar/], -from => 'Foo|f', - -where => {"f.bar" => 123}, + -where => {'f.bar' => 123}, ); is_same_sql_bind( $sql, \@bind, - "SELECT bar FROM Foo AS f WHERE f.bar = ?", [123], - "-from with alias" + 'SELECT bar FROM Foo AS f WHERE f.bar = ?', [123], + '-from with alias' ); @@ -103,7 +103,7 @@ is_same_sql_bind( ); is_same_sql_bind( $sql, \@bind, - "SELECT DISTINCT foo, bar FROM Foo", [], + 'SELECT DISTINCT foo, bar FROM Foo', [], ); # other minus signs @@ -113,7 +113,7 @@ is_same_sql_bind( ); is_same_sql_bind( $sql, \@bind, - "SELECT DISTINCT STRAIGHT_JOIN foo, bar FROM Foo", [], + 'SELECT DISTINCT STRAIGHT_JOIN foo, bar FROM Foo', [], ); ($sql, @bind) = $sqla->select( @@ -122,29 +122,29 @@ is_same_sql_bind( ); is_same_sql_bind( $sql, \@bind, - "SELECT SQL_SMALL_RESULT foo, bar FROM Foo", [], + 'SELECT SQL_SMALL_RESULT foo, bar FROM Foo', [], ); ($sql, @bind) = $sqla->select( - -columns => ["-/*+ FIRST_ROWS (100) */" => qw/foo bar/], + -columns => ['-/*+ FIRST_ROWS (100) */' => qw/foo bar/], -from => 'Foo', ); is_same_sql_bind( $sql, \@bind, - "SELECT /*+ FIRST_ROWS (100) */ foo, bar FROM Foo", [], + 'SELECT /*+ FIRST_ROWS (100) */ foo, bar FROM Foo', [], ); # subquery as column, simple example ($sql, @bind) = $sqla->select( - -columns => ["col1", \ [ "(SELECT max(bar) FROM Bar WHERE bar < ?)|col2", 123], "col3"], + -columns => ['col1', \ [ '(SELECT max(bar) FROM Bar WHERE bar < ?)|col2', 123], 'col3'], -from => 'Foo', -where => {foo => 456}, ); is_same_sql_bind( $sql, \@bind, - "SELECT col1, (SELECT max(bar) FROM Bar WHERE bar < ?) AS col2, col3 FROM Foo WHERE foo = ?", [123, 456], - "subquery in select list", + 'SELECT col1, (SELECT max(bar) FROM Bar WHERE bar < ?) AS col2, col3 FROM Foo WHERE foo = ?', [123, 456], + 'subquery in select list', ); @@ -163,11 +163,11 @@ my $subquery = ["($subq_sql)|col3", @subq_bind]; ); is_same_sql_bind( $sql, \@bind, - "SELECT col1, col2, + 'SELECT col1, col2, (SELECT COUNT(*) FROM Foo WHERE bar_id=Bar.bar_id and height BETWEEN ? AND ?) AS col3, col4 - FROM Bar WHERE color = ?", [100, 200, 'green'], - "subquery, example from the doc"); + FROM Bar WHERE color = ?', [100, 200, 'green'], + 'subquery, example from the doc'); # subquery in the -from arg @@ -185,11 +185,11 @@ $subquery = ["($subq_sql)|subq", @subq_bind]; ); is_same_sql_bind( $sql, \@bind, - "SELECT subq.*, count(*) AS nb_a + 'SELECT subq.*, count(*) AS nb_a FROM (SELECT a, b, c FROM Foo WHERE foo = ?) AS subq WHERE b = ? - GROUP BY a", [123, 456], - "subquery in -from"); + GROUP BY a', [123, 456], + 'subquery in -from'); # subq example from the synopsis @@ -201,7 +201,7 @@ is_same_sql_bind( ) ]; my $subq2 = [ $sqla->select(-columns => 'MAX(amount)', -from => 'Expenses', - -where => {exp_id => {-ident => 'x'}, date => {">" => '01.01.2024'}}, + -where => {exp_id => {-ident => 'x'}, date => {'>' => '01.01.2024'}}, -as => 'max_amount', ) ]; ($sql, @bind) = $sqla->select( @@ -211,25 +211,25 @@ is_same_sql_bind( ); is_same_sql_bind( $sql, \@bind, - " SELECT x, (SELECT MAX(amount) FROM Expenses WHERE ( date > ? AND exp_id = x)) AS max_amount + ' SELECT x, (SELECT MAX(amount) FROM Expenses WHERE ( date > ? AND exp_id = x)) AS max_amount FROM (SELECT f AS x FROM Foo UNION SELECT b AS x FROM Bar WHERE barbar = ?) AS Foo_union_Bar - ORDER BY x", ['01.01.2024', 123], - "subqueries in column list and in source"); + ORDER BY x', ['01.01.2024', 123], + 'subqueries in column list and in source'); # subquery with -in my $subq = [ $sqla->select(-columns => 'x', -from => 'Bar', - -where => {y => {"<" => 100}}) ]; + -where => {y => {'<' => 100}}) ]; ($sql, @bind) = $sqla->select( -from => 'Foo', -where => {x => {-in => \$subq}}, ); is_same_sql_bind( $sql, \@bind, - "SELECT * FROM Foo WHERE (x IN (SELECT x FROM Bar WHERE ( y < ? )))", + 'SELECT * FROM Foo WHERE (x IN (SELECT x FROM Bar WHERE ( y < ? )))', [100], - "select -in => subquery", + 'select -in => subquery', ); @@ -239,8 +239,8 @@ is_same_sql_bind( ); is_same_sql_bind( $sql, \@bind, - "SELECT * FROM Foo INNER JOIN Bar ON Foo.fk=Bar.pk", [], - "select from join", + 'SELECT * FROM Foo INNER JOIN Bar ON Foo.fk=Bar.pk', [], + 'select from join', ); # -join with bind values @@ -249,10 +249,32 @@ is_same_sql_bind( ); is_same_sql_bind( $sql, \@bind, - "SELECT * FROM Foo INNER JOIN Bar ON Foo.fk=Bar.pk and Foo.other = ?", ['abc'], - "select from join with bind value", + 'SELECT * FROM Foo INNER JOIN Bar ON Foo.fk=Bar.pk and Foo.other = ?', ['abc'], + 'select from join with bind value', ); +# join with two literal table expressings and using +($sql, @bind) = $sqla->select( + -from => [ -join => + 'SELECT id1 AS id FROM table1 WHERE (id1 > 2)|a', + {operator => '<=>', + using => [ 'id' ]}, + 'SELECT id2 AS id FROM table2 WHERE (id2 > 2 )|b', + ], + -columns => [ 'a.id1|aid', 'b.id2|bid' ] +); +is_same_sql_bind( + $sql, \@bind, + q{ SELECT a.id1 as aid, b.id2 as bid + FROM + SELECT id1 as id FROM table1 WHERE (id1 > 2) AS a + INNER JOIN + SELECT id2 as id FROM table2 WHERE (id2 > 2) AS b + USING (id ) + }, + [], + 'join with two literal table expressings and using' +); # set operators @@ -267,10 +289,10 @@ is_same_sql_bind( ); is_same_sql_bind( $sql, \@bind, - "SELECT col1, col2 FROM Foo WHERE col1 = ? " - ." INTERSECT SELECT col3, col4 FROM Bar WHERE col3 = ?", + 'SELECT col1, col2 FROM Foo WHERE col1 = ? ' + .' INTERSECT SELECT col3, col4 FROM Bar WHERE col3 = ?', [123, 456], - "from q1 intersect q2", + 'from q1 intersect q2', ); ($sql, @bind) = $sqla->select( @@ -285,12 +307,12 @@ is_same_sql_bind( ); is_same_sql_bind( $sql, \@bind, - "SELECT col1, col2 FROM Foo WHERE col1 = ? " - ." UNION ALL SELECT col1, col2 FROM Foo WHERE col2 = ?" - ." UNION ALL SELECT col1, col3 FROM Foo WHERE col3 = ?" - ." ORDER BY col1, col2", + 'SELECT col1, col2 FROM Foo WHERE col1 = ? ' + .' UNION ALL SELECT col1, col2 FROM Foo WHERE col2 = ?' + .' UNION ALL SELECT col1, col3 FROM Foo WHERE col3 = ?' + .' ORDER BY col1, col2', [123, 456, 789], - "from q1 union_all q2", + 'from q1 union_all q2', ); #-order_by @@ -300,7 +322,7 @@ is_same_sql_bind( ); is_same_sql_bind( $sql, \@bind, - "SELECT * FROM Foo ORDER BY foo DESC, bar ASC, buz", [], + 'SELECT * FROM Foo ORDER BY foo DESC, bar ASC, buz', [], ); #-group_by / -having @@ -308,12 +330,12 @@ is_same_sql_bind( -columns => [qw/foo SUM(bar)|sum_bar/], -from => 'Foo', -group_by => [qw/foo/], - -having => {sum_bar => {">" => 10}}, + -having => {sum_bar => {'>' => 10}}, ); is_same_sql_bind( $sql, \@bind, - "SELECT foo, SUM(bar) AS sum_bar FROM Foo GROUP BY foo HAVING sum_bar > ?", [10], - "group by / having", + 'SELECT foo, SUM(bar) AS sum_bar FROM Foo GROUP BY foo HAVING sum_bar > ?', [10], + 'group by / having', ); #-having @@ -321,12 +343,12 @@ is_same_sql_bind( -columns => [qw/SUM(bar)|sum_bar/], -from => 'Foo', -where => { foo => 1 }, - -having => {sum_bar => {">" => 10}}, + -having => {sum_bar => {'>' => 10}}, ); is_same_sql_bind( $sql, \@bind, - "SELECT SUM(bar) AS sum_bar FROM Foo WHERE ( foo = ? ) HAVING ( sum_bar > ? )", [1,10], - "group by / having (2)", + 'SELECT SUM(bar) AS sum_bar FROM Foo WHERE ( foo = ? ) HAVING ( sum_bar > ? )', [1,10], + 'group by / having (2)', ); #-limit alone @@ -336,7 +358,7 @@ is_same_sql_bind( ); is_same_sql_bind( $sql, \@bind, - "SELECT * FROM Foo LIMIT ? OFFSET ?", [100, 0], + 'SELECT * FROM Foo LIMIT ? OFFSET ?', [100, 0], ); ($sql, @bind) = $sqla->select( @@ -345,8 +367,8 @@ is_same_sql_bind( ); is_same_sql_bind( $sql, \@bind, - "SELECT * FROM Foo LIMIT ? OFFSET ?", [0, 0], - "limit 0", + 'SELECT * FROM Foo LIMIT ? OFFSET ?', [0, 0], + 'limit 0', ); @@ -359,7 +381,7 @@ is_same_sql_bind( ); is_same_sql_bind( $sql, \@bind, - "SELECT * FROM Foo LIMIT ? OFFSET ?", [100, 300], + 'SELECT * FROM Foo LIMIT ? OFFSET ?', [100, 300], ); @@ -371,18 +393,18 @@ is_same_sql_bind( ); is_same_sql_bind( $sql, \@bind, - "SELECT * FROM Foo LIMIT ? OFFSET ?", [50, 50], + 'SELECT * FROM Foo LIMIT ? OFFSET ?', [50, 50], ); # -for ($sql, @bind) = $sqla->select( -from => 'Foo', - -for => "UPDATE", + -for => 'UPDATE', ); is_same_sql_bind( $sql, \@bind, - "SELECT * FROM Foo FOR UPDATE", [], + 'SELECT * FROM Foo FOR UPDATE', [], ); # -want_details @@ -393,23 +415,23 @@ my $details = $sqla->select( ); is_same_sql_bind( $details->{sql}, $details->{bind}, - "SELECT f.col1 AS c1, b.col2 AS c2 FROM Foo AS f INNER JOIN Bar AS b ON f.fk=b.pk", [], + 'SELECT f.col1 AS c1, b.col2 AS c2 FROM Foo AS f INNER JOIN Bar AS b ON f.fk=b.pk', [], ); is_deeply($details->{aliased_tables}, {f => 'Foo', b => 'Bar'}, - "aliased tables"); + 'aliased tables'); is_deeply($details->{aliased_columns}, {c1 => 'f.col1', c2 => 'b.col2'}, - "aliased columns"); + 'aliased columns'); -# aliasing, do not conflict with "||" operator +# aliasing, do not conflict with '||' operator ($sql, @bind) = $sqla->select( -columns => [qw/A||B C||D|cd (E||F||G)|efg true|false|bool/], -from => 'Foo', ); is_same_sql_bind( $sql, \@bind, - "SELECT A||B, C||D AS cd, (E||F||G) AS efg, true|false AS bool FROM Foo", [], - "aliased cols with '|'" + 'SELECT A||B, C||D AS cd, (E||F||G) AS efg, true|false AS bool FROM Foo', [], + 'aliased cols with '|'' ); ($sql, @bind) = $sqla->select( @@ -418,8 +440,8 @@ is_same_sql_bind( ); is_same_sql_bind( $sql, \@bind, - "SELECT NULL AS a1, 2 AS a2, x AS a3 FROM Foo", [], - "aliased cols with '|', single char on left-hand side" + 'SELECT NULL AS a1, 2 AS a2, x AS a3 FROM Foo', [], + 'aliased cols with '|', single char on left-hand side' ); @@ -431,20 +453,20 @@ is_same_sql_bind( ); is_same_sql_bind( $sql, \@bind, - "SELECT * FROM Foo WHERE foo = ?", + 'SELECT * FROM Foo WHERE foo = ?', [ [{dbd_attrs => {ora_type => 'TEST'}}, 123] ], - "SQL type with implicit = operator", + 'SQL type with implicit = operator', ); ($sql, @bind) = $sqla->select( -from => 'Foo', - -where => {bar => {"<" => [{dbd_attrs => {pg_type => 999}}, 456]}}, + -where => {bar => {'<' => [{dbd_attrs => {pg_type => 999}}, 456]}}, ); is_same_sql_bind( $sql, \@bind, - "SELECT * FROM Foo WHERE bar < ?", + 'SELECT * FROM Foo WHERE bar < ?', [ [{dbd_attrs => {pg_type => 999}}, 456] ], - "SQL type with explicit operator", + 'SQL type with explicit operator', ); @@ -454,9 +476,9 @@ is_same_sql_bind( ); is_same_sql_bind( $sql, \@bind, - "INSERT INTO Foo(x) VALUES(?)", + 'INSERT INTO Foo(x) VALUES(?)', [ [{dbd_attrs => {pg_type => 999}}, 456] ], - "INSERT with SQL type", + 'INSERT with SQL type', ); ($sql, @bind) = $sqla->update( @@ -466,9 +488,9 @@ is_same_sql_bind( ); is_same_sql_bind( $sql, \@bind, - "UPDATE Foo SET x = ? WHERE bar = ?", + 'UPDATE Foo SET x = ? WHERE bar = ?', [ [{dbd_attrs => {pg_type => 999}}, 456], 'buz' ], - "UPDATE with SQL type", + 'UPDATE with SQL type', ); @@ -476,13 +498,13 @@ is_same_sql_bind( # should not be interpreted as bind_params with SQL types ($sql, @bind) = $sqla->select( -from => 'Foo', - -where => {bar => [{"=" => undef}, {"<" => 'foo'}]} + -where => {bar => [{'=' => undef}, {'<' => 'foo'}]} ); is_same_sql_bind( $sql, \@bind, - "SELECT * FROM Foo WHERE bar IS NULL OR bar < ?", + 'SELECT * FROM Foo WHERE bar IS NULL OR bar < ?', [ 'foo' ], - "OR arrayref pair which is not a value/type pair", + 'OR arrayref pair which is not a value/type pair', ); @@ -494,53 +516,53 @@ is_same_sql_bind( ($sql, @bind) = $sqla->column_alias(qw/Foo f/); is_same_sql_bind( $$sql, \@bind, - "Foo AS f", [], - "column alias", + 'Foo AS f', [], + 'column alias', ); ($sql, @bind) = $sqla->column_alias(qw/Foo/); is_same_sql_bind( $sql, \@bind, - "Foo", [], - "column alias without alias", + 'Foo', [], + 'column alias without alias', ); ($sql, @bind) = $sqla->table_alias(qw/Foo f/); is_same_sql_bind( $sql, \@bind, - "Foo AS f", [], - "table alias", + 'Foo AS f', [], + 'table alias', ); ($sql, @bind) = $sqla->limit_offset(123, 456); is_same_sql_bind( $sql, \@bind, - "LIMIT ? OFFSET ?", [123, 456], - "limit offset", + 'LIMIT ? OFFSET ?', [123, 456], + 'limit offset', ); $join = $sqla->join(qw[Foo|f =>{fk_A=pk_A,fk_B=pk_B} Bar]); is_same_sql_bind( $join->{sql}, $join->{bind}, - "Foo AS f LEFT OUTER JOIN Bar ON f.fk_A = Bar.pk_A AND f.fk_B = Bar.pk_B", [], - "join syntax", + 'Foo AS f LEFT OUTER JOIN Bar ON f.fk_A = Bar.pk_A AND f.fk_B = Bar.pk_B', [], + 'join syntax', ); $join = $sqla->join(qw[Foo <=>[A{sql}, $join->{bind}, - "Foo INNER JOIN Bar ON Foo.A < Bar.B OR Foo.C < Bar.D", [], - "join syntax with OR", + 'Foo INNER JOIN Bar ON Foo.A < Bar.B OR Foo.C < Bar.D', [], + 'join syntax with OR', ); $join = $sqla->join(qw[Foo == Bar]); is_same_sql_bind( $join->{sql}, $join->{bind}, - "Foo NATURAL JOIN Bar", [], - "natural join", + 'Foo NATURAL JOIN Bar', [], + 'natural join', ); @@ -550,10 +572,10 @@ $join = $sqla->join(qw[Table1|t1 ab=cd Table2|t2 =>{t1.mn=op} Table4]); is_same_sql_bind( $join->{sql}, $join->{bind}, - "Table1 AS t1 INNER JOIN Table2 AS t2 ON t1.ab=t2.cd + 'Table1 AS t1 INNER JOIN Table2 AS t2 ON t1.ab=t2.cd INNER JOIN Table3 ON t2.ef>Table3.gh AND t2.ijjoin(qw[Foo >=<{a=b} Bar]); is_same_sql_bind( $join->{sql}, $join->{bind}, - "Foo FULL OUTER JOIN Bar ON Foo.a=Bar.b", [], - "full outer join", + 'Foo FULL OUTER JOIN Bar ON Foo.a=Bar.b', [], + 'full outer join', ); @@ -572,19 +594,19 @@ is_same_sql_bind( $join = $sqla->join(qw[Table1|t1 t1.ab=t2.cd Table2|t2]); is_same_sql_bind( $join->{sql}, $join->{bind}, - "Table1 AS t1 INNER JOIN Table2 AS t2 ON t1.ab=t2.cd", + 'Table1 AS t1 INNER JOIN Table2 AS t2 ON t1.ab=t2.cd', [], - "explicit tables in join condition" + 'explicit tables in join condition' ); my $merged = $sqla->merge_conditions( - {a => 12, b => {">" => 34}}, - {b => {"<" => 56}, c => 78}, + {a => 12, b => {'>' => 34}}, + {b => {'<' => 56}, c => 78}, ); is_deeply($merged, - {a => 12, b => [-and => {">" => 34}, {"<" => 56}], c => 78}); + {a => 12, b => [-and => {'>' => 34}, {'<' => 56}], c => 78}); #---------------------------------------------------------------------- @@ -592,25 +614,25 @@ is_deeply($merged, #---------------------------------------------------------------------- $sqla = SQL::Abstract::More->new(table_alias => '%1$s %2$s', - limit_offset => "LimitXY", - sql_dialect => "MsAccess"); + limit_offset => 'LimitXY', + sql_dialect => 'MsAccess'); $join = $sqla->join(qw[Foo|f =>{fk_A=pk_A,fk_B=pk_B} Bar]); is_same_sql_bind( $join->{sql}, $join->{bind}, - "Foo f LEFT OUTER JOIN (Bar) ON f.fk_A = Bar.pk_A AND f.fk_B = Bar.pk_B", [], + 'Foo f LEFT OUTER JOIN (Bar) ON f.fk_A = Bar.pk_A AND f.fk_B = Bar.pk_B', [], ); ($sql, @bind) = $sqla->limit_offset(123, 456); is_same_sql_bind( $sql, \@bind, - "LIMIT ?, ?", [456, 123] + 'LIMIT ?, ?', [456, 123] ); ok($sqla->join_assoc_right, - "join_assoc_right is true"); + 'join_assoc_right is true'); $sqla = SQL::Abstract::More->new(sql_dialect => 'Oracle'); @@ -620,7 +642,7 @@ $sqla = SQL::Abstract::More->new(sql_dialect => 'Oracle'); ); is_same_sql_bind( $sql, \@bind, - "SELECT col1 c1, col2 c2 FROM Foo f INNER JOIN Bar b ON f.fk=b.pk", + 'SELECT col1 c1, col2 c2 FROM Foo f INNER JOIN Bar b ON f.fk=b.pk', [] ); @@ -632,7 +654,7 @@ is_same_sql_bind( is_same_sql_bind( $sql, \@bind, - "SELECT * FROM (SELECT subq_A.*, ROWNUM rownum__index FROM (SELECT * FROM Foo) subq_A WHERE ROWNUM <= ?) subq_B WHERE rownum__index >= ?", + 'SELECT * FROM (SELECT subq_A.*, ROWNUM rownum__index FROM (SELECT * FROM Foo) subq_A WHERE ROWNUM <= ?) subq_B WHERE rownum__index >= ?', [15, 6], ); @@ -643,9 +665,9 @@ $sqla = SQL::Abstract::More->new(sql_dialect => 'Oracle12c'); ($sql, @bind) = $sqla->limit_offset(123, 456); is_same_sql_bind( $sql, \@bind, - "OFFSET ? ROWS FETCH NEXT ? ROWS ONLY", + 'OFFSET ? ROWS FETCH NEXT ? ROWS ONLY', [456, 123], - "limit/offset for Oracle12c", + 'limit/offset for Oracle12c', ); @@ -656,17 +678,17 @@ is_same_sql_bind( $sqla = SQL::Abstract::More->new( limit_offset => sub { my ($self, $limit, $offset) = @_; - defined $limit or die "NO LIMIT!"; + defined $limit or die 'NO LIMIT!'; $offset ||= 0; my $last = $offset + $limit; - return ("ROWS ? TO ?", $offset, $last); # ($sql, @bind) + return ('ROWS ? TO ?', $offset, $last); # ($sql, @bind) }); ($sql, @bind) = $sqla->limit_offset(123, 456); is_same_sql_bind( $sql, \@bind, - "ROWS ? TO ?", [456, 579] + 'ROWS ? TO ?', [456, 579] ); @@ -751,21 +773,21 @@ my $sqla_RO = SQL::Abstract::More->new( is_same_sql_bind( $sql, \@bind, 'SELECT * FROM FOO FOR READ ONLY', [], - "select_implicitly_for - basic", + 'select_implicitly_for - basic', ); ($sql, @bind) = $sqla_RO->select(-from => 'Foo', -for => 'UPDATE'); is_same_sql_bind( $sql, \@bind, 'SELECT * FROM FOO FOR UPDATE', [], - "select_implicitly_for - override", + 'select_implicitly_for - override', ); ($sql, @bind) = $sqla_RO->select(-from => 'Foo', -for => undef); is_same_sql_bind( $sql, \@bind, 'SELECT * FROM FOO', [], - "select_implicitly_for - disable", + 'select_implicitly_for - disable', ); @@ -783,7 +805,7 @@ is_same_sql_bind( $sql, \@bind, 'INSERT INTO Foo(bar, foo) VALUES (?, ?)', [2, 1], - "insert - hashref", + 'insert - hashref', ); # arrayref syntax @@ -795,7 +817,7 @@ is_same_sql_bind( $sql, \@bind, 'INSERT INTO Foo VALUES (?, ?)', [1, 2], - "insert - arrayref", + 'insert - arrayref', ); @@ -809,7 +831,7 @@ is_same_sql_bind( $sql, \@bind, 'INSERT INTO Foo(a, b) SELECT x, y FROM Bar', [], - "insert .. select", + 'insert .. select', ); @@ -890,14 +912,14 @@ is_same_sql_bind( # bind_params SKIP: { - eval "use DBD::Mock 1.48; 1" - or skip "DBD::Mock 1.48 does not seem to be installed", N_DBI_MOCK_TESTS; + eval 'use DBD::Mock 1.48; 1' + or skip 'DBD::Mock 1.48 does not seem to be installed', N_DBI_MOCK_TESTS; my $dbh = DBI->connect('DBI:Mock:', '', '', {RaiseError => 1}); my $sth = $dbh->prepare($sql); $sqla->bind_params($sth, @bind); my $mock_params = $sth->{mock_params}; - is_deeply($sth->{mock_params}, [2, 1, \$k2, \$k1], "bind_param_inout"); + is_deeply($sth->{mock_params}, [2, 1, \$k2, \$k1], 'bind_param_inout'); # test 3-args form of bind_param $sth = $dbh->prepare('INSERT INTO Foo(bar, foo) VALUES (?, ?)'); @@ -973,7 +995,7 @@ is_same_sql_bind( $sql, \@bind, 'UPDATE Foo SET bar = ?, foo = ? WHERE buz = ? ORDER BY baz LIMIT ?', [2, 1, 3, 10], - "update with -order_by/-limit", + 'update with -order_by/-limit', ); ($sql, @bind) = $sqla->update( @@ -1058,7 +1080,7 @@ is_same_sql_bind( $sql, \@bind, 'DELETE FROM Foo WHERE buz = ?', [3], - "delete", + 'delete', ); # old API @@ -1067,7 +1089,7 @@ is_same_sql_bind( $sql, \@bind, 'DELETE FROM Foo WHERE buz = ?', [3], - "delete, old API", + 'delete, old API', ); # support for table aliases @@ -1079,7 +1101,7 @@ is_same_sql_bind( $sql, \@bind, 'DELETE FROM Foo AS a WHERE buz = ?', [3], - "delete with table alias", + 'delete with table alias', ); # MySQL supports -limit and -order_by in deletes ! @@ -1094,7 +1116,7 @@ is_same_sql_bind( $sql, \@bind, 'DELETE FROM Foo WHERE buz = ? ORDER BY baz LIMIT ?', [3, 10], - "delete with -order_by/-limit", + 'delete with -order_by/-limit', ); @@ -1147,6 +1169,40 @@ is_same_sql_bind( [], ); +#---------------------------------------------------------------------- +# CTE +#---------------------------------------------------------------------- + +$sqla = SQL::Abstract::More->new; +$sqla = $sqla->with( + -table => 't2', + -columns => [ 'store', 'avg_order' ], + -as_select => { + -from => 'Table1', + -columns => [ 'store', 'average_order' ], + -group_by => 'store', + } +); + +($sql, @bind ) = $sqla->select( + -from => [ -join => qw/Table1|t1 {store} t2/ ], + -columns => [ 't1.id', 't2.avg_order|avg' ], +); + +is_same_sql_bind( + $sql, \@bind, +q{WITH t2 (store,avg_order) AS + (SELECT store, average_order + FROM table1 + GROUP BY store) +SELECT t1.id, t2.avg_order AS avg +FROM Table1 AS t1 +INNER JOIN t2 USING(store) +}, +[], +'CTE' +); + #---------------------------------------------------------------------- # THE END diff --git a/t/08-sql_abstract_more_quoted.t b/t/08-sql_abstract_more_quoted.t new file mode 100644 index 0000000..1243bab --- /dev/null +++ b/t/08-sql_abstract_more_quoted.t @@ -0,0 +1,1253 @@ +use strict; +use warnings; +no warnings 'qw'; +use SQL::Abstract::More; +use Test::More; +use SQL::Abstract::Test import => [qw/is_same_sql_bind/]; + +my ($parent_SQLA) = @SQL::Abstract::More::ISA; +my $parent_version = $parent_SQLA->VERSION; + +diag( "Testing SQL::Abstract::More $SQL::Abstract::More::VERSION, " + ."extends $parent_SQLA version $parent_version, Perl $], $^X" ); + +use constant N_DBI_MOCK_TESTS => 2; + + +sub sqla { SQL::Abstract::More->new ( + quote_char => q{"}, name_sep => q{.}, @_) +} +my $sqla = sqla(); +my ($sql, @bind, $join); + + +#---------------------------------------------------------------------- +# various forms of select() +#---------------------------------------------------------------------- + +# old API transmitted to parent +($sql, @bind) = $sqla->select('Foo', ['bar'], {bar => {'>' => 123}}, ['bar']); +is_same_sql_bind( + $sql, \@bind, + 'SELECT "bar" FROM "Foo" WHERE ( "bar" > ? ) ORDER BY "bar"', [123], + 'old API (positional parameters)', +); + +# idem, new API +($sql, @bind) = $sqla->select( + -columns => [qw/bar/], + -from => 'Foo', + -where => {bar => {'>' => 123}}, + -order_by => ['bar'] +); +is_same_sql_bind( + $sql, \@bind, + 'SELECT "bar" FROM "Foo" WHERE ( "bar" > ? ) ORDER BY "bar"', [123], + 'new API : named parameters', +); + +# pass one table as array +($sql, @bind) = $sqla->select( + -columns => [qw/bar/], + -from => ['Foo'], + -where => {bar => {'>' => 123}}, + -order_by => ['bar'] +); +is_same_sql_bind( + $sql, \@bind, + 'SELECT "bar" FROM "Foo" WHERE "bar" > ? ORDER BY "bar"', [123], + '-from => arrayref (1 table)', +); + + +# pass several tables as array +($sql, @bind) = $sqla->select( + -columns => [qw/bar/], + -from => [qw/Foo Bar Buz/], + -where => {bar => {'>' => 123}}, +); +is_same_sql_bind( + $sql, \@bind, + 'SELECT "bar" FROM "Foo", "Bar", "Buz" WHERE ( "bar" > ? )', [123], + '-from => arrayref (several tables)', +); + + +($sql, @bind) = $sqla->select( + -columns => [qw/bar/], + -from => \ 'Foo', + -where => {bar => {'>' => 123}}, +); +is_same_sql_bind( + $sql, \@bind, + 'SELECT "bar" FROM "Foo" WHERE "bar" > ?', [123], + '-from => scalarref', +); + + +# -from with alias +($sql, @bind) = $sqla->select( + -columns => [qw/bar/], + -from => 'Foo|f', + -where => {'f.bar' => 123}, +); +is_same_sql_bind( + $sql, \@bind, + 'SELECT "bar" FROM "Foo" AS "f" WHERE ( "f"."bar" = ? )', [123], + '-from with alias' +); + + + +# -distinct +($sql, @bind) = $sqla->select( + -columns => [-DISTINCT => qw/foo bar/], + -from => 'Foo', +); +is_same_sql_bind( + $sql, \@bind, + 'SELECT DISTINCT "foo", "bar" FROM "Foo"', [], +); + +# other minus signs +($sql, @bind) = $sqla->select( + -columns => [-DISTINCT => -STRAIGHT_JOIN => qw/foo bar/], + -from => 'Foo', +); +is_same_sql_bind( + $sql, \@bind, + 'SELECT DISTINCT STRAIGHT_JOIN "foo", "bar" FROM "Foo"', [], +); + +($sql, @bind) = $sqla->select( + -columns => [-SQL_SMALL_RESULT => qw/foo bar/], + -from => 'Foo', +); +is_same_sql_bind( + $sql, \@bind, + 'SELECT SQL_SMALL_RESULT "foo", "bar" FROM "Foo"', [], +); + +($sql, @bind) = $sqla->select( + -columns => ['-/*+ FIRST_ROWS (100) */' => qw/foo bar/], + -from => 'Foo', +); +is_same_sql_bind( + $sql, \@bind, + 'SELECT /*+ FIRST_ROWS (100) */ "foo", "bar" FROM "Foo"', [], +); + + +# subquery as column, simple example +($sql, @bind) = $sqla->select( + -columns => ['col1', \ [ '(SELECT max(bar) FROM Bar WHERE bar < ?)|col2', 123], 'col3'], + -from => 'Foo', + -where => {foo => 456}, +); +is_same_sql_bind( + $sql, \@bind, + 'SELECT "col1", (SELECT max(bar) FROM Bar WHERE bar < ?) AS "col2", "col3" FROM "Foo" WHERE ( "foo" = ? )', [123, 456], + 'subquery in select list', +); + + +# subquery as column, example from the doc +my ($subq_sql, @subq_bind) = $sqla->select( + -columns => 'COUNT(*)|count', + -from => 'Foo', + -where => {bar_id => {-ident => 'Bar.bar_id'}, + height => {-between => [100, 200]}}, + ); +my $subquery = ["($subq_sql)|col3", @subq_bind]; +($sql, @bind) = $sqla->select( + -from => 'Bar', + -columns => ['col1', 'col2', \$subquery, , 'col4'], # reference to an arrayref ! + -where => {color => 'green'}, + ); +is_same_sql_bind( + $sql, \@bind, + 'SELECT "col1", "col2", + (SELECT COUNT(*) AS "count" FROM "Foo" WHERE ( ( "bar_id" ="Bar"."bar_id") and ( "height" BETWEEN ? AND ?) ) ) AS "col3", + "col4" + FROM "Bar" WHERE ("color" = ?)', [100, 200, 'green'], + 'subquery, example from the doc'); + + +# subquery in the -from arg +($subq_sql, @subq_bind) = $sqla->select( + -columns => [qw/a b c/], + -from => 'Foo', + -where => {foo => 123}, + ); +$subquery = ["($subq_sql)|subq", @subq_bind]; +($sql, @bind) = $sqla->select( + -from => \$subquery, + -columns => ['subq.*', 'count(*)|nb_a'], + -where => {b => 456}, + -group_by => 'a', + ); +is_same_sql_bind( + $sql, \@bind, + 'SELECT "subq".*, count(*) AS "nb_a" + FROM (SELECT "a", "b", "c" FROM "Foo" WHERE ( "foo" = ? )) AS "subq" + WHERE ( "b" = ? ) + GROUP BY "a"', [123, 456], + 'subquery in -from'); + + +# subq example from the synopsis + my $subq1 = [ $sqla->select(-columns => 'f|x', -from => 'Foo', + -union => [-columns => 'b|x', + -from => 'Bar', + -where => {barbar => 123}], + -as => 'Foo_union_Bar', + ) ]; + my $subq2 = [ $sqla->select(-columns => 'MAX(amount)', + -from => 'Expenses', + -where => {exp_id => {-ident => 'x'}, date => {'>' => '01.01.2024'}}, + -as => 'max_amount', + ) ]; + ($sql, @bind) = $sqla->select( + -columns => ['x', \$subq2], + -from => \$subq1, + -order_by => 'x', + ); +is_same_sql_bind( + $sql, \@bind, + 'SELECT "x", (SELECT MAX(amount) FROM "Expenses" WHERE ( ( "date" > ? AND "exp_id" = "x" ) )) AS "max_amount" + FROM (SELECT "f" AS "x" FROM "Foo" UNION SELECT "b" AS "x" FROM "Bar" WHERE ( "barbar" = ? )) AS "Foo_union_Bar" + ORDER BY "x"', ['01.01.2024', 123], + 'subqueries in column list and in source'); + + +# subquery with -in +my $subq = [ $sqla->select(-columns => 'x', + -from => 'Bar', + -where => {y => {'<' => 100}}) ]; +($sql, @bind) = $sqla->select( + -from => 'Foo', + -where => {x => {-in => \$subq}}, +); +is_same_sql_bind( + $sql, \@bind, + 'SELECT * FROM "Foo" WHERE ("x" IN (SELECT "x" FROM "Bar" WHERE ( "y" < ? )))', + [100], + 'select -in => subquery', + ); + + +# -join +($sql, @bind) = $sqla->select( + -from => [-join => qw/Foo fk=pk Bar/] +); +is_same_sql_bind( + $sql, \@bind, + 'SELECT * FROM "Foo" INNER JOIN "Bar" ON ( "Foo"."fk" = "Bar"."pk" )', [], + 'select from join', +); + +# -join with bind values +($sql, @bind) = $sqla->select( + -from => [-join => qw/Foo {fk=pk,other='abc'} Bar/] +); +is_same_sql_bind( + $sql, \@bind, + 'SELECT * FROM "Foo" INNER JOIN "Bar" ON ( ( "Foo"."fk"="Bar"."pk" and "Foo"."other" = ? ) )', ['abc'], + 'select from join with bind value', +); + + +# join with two literal table expressings and using +($sql, @bind) = $sqla->select( + -from => [ -join => + 'SELECT "id1" AS "id" FROM "table1" WHERE ("id1" > 2)|a', + {operator => '<=>', + using => [ 'id' ]}, + 'SELECT "id2" AS "id" FROM "table2" WHERE ("id2" > 2 )|b', + ], + -columns => [ 'a.id1|aid', 'b.id2|bid' ] +); +is_same_sql_bind( + $sql, \@bind, + q{ SELECT "a"."id1" as "aid", "b"."id2" as "bid" + FROM + SELECT "id1" as "id" FROM "table1" WHERE ("id1" > 2) AS "a" + INNER JOIN + SELECT "id2" as "id" FROM "table2" WHERE ("id2" > 2) AS "b" + USING ("id" ) + }, + [], + 'join with two literal table expressings and using' +); + + +# set operators +($sql, @bind) = $sqla->select( + -columns => [qw/col1 col2/], + -from => 'Foo', + -where => {col1 => 123}, + -intersect => [ -columns => [qw/col3 col4/], + -from => 'Bar', + -where => {col3 => 456}, + ], +); +is_same_sql_bind( + $sql, \@bind, + 'SELECT "col1", "col2" FROM "Foo" WHERE "col1" = ? ' + .' INTERSECT SELECT "col3", "col4" FROM "Bar" WHERE "col3" = ?', + [123, 456], + 'from q1 intersect q2', +); + +($sql, @bind) = $sqla->select( + -columns => [qw/col1 col2/], + -from => 'Foo', + -where => {col1 => 123}, + -union_all => [ -where => {col2 => 456}, + -union_all => [-columns => [qw/col1 col3/], + -where => {col3 => 789}, ], + ], + -order_by => [qw/col1 col2/], +); +is_same_sql_bind( + $sql, \@bind, + 'SELECT "col1", "col2" FROM "Foo" WHERE "col1" = ? ' + .' UNION ALL SELECT "col1", "col2" FROM "Foo" WHERE "col2" = ?' + .' UNION ALL SELECT "col1", "col3" FROM "Foo" WHERE "col3" = ?' + .' ORDER BY "col1", "col2"', + [123, 456, 789], + 'from q1 union_all q2', +); + +#-order_by +($sql, @bind) = $sqla->select( + -from => 'Foo', + -order_by => [qw/-foo +bar buz/], +); +is_same_sql_bind( + $sql, \@bind, + 'SELECT * FROM "Foo" ORDER BY "foo" DESC, "bar" ASC, "buz"', [], +); + +#-group_by / -having +($sql, @bind) = $sqla->select( + -columns => [qw/foo SUM(bar)|sum_bar/], + -from => 'Foo', + -group_by => [qw/foo/], + -having => {sum_bar => {'>' => 10}}, +); +is_same_sql_bind( + $sql, \@bind, + 'SELECT "foo", SUM(bar) AS "sum_bar" FROM "Foo" GROUP BY "foo" HAVING "sum_bar" > ?', [10], + 'group by / having', +); + +#-having +($sql, @bind) = $sqla->select( + -columns => [qw/SUM(bar)|sum_bar/], + -from => 'Foo', + -where => { foo => 1 }, + -having => {sum_bar => {'>' => 10}}, +); +is_same_sql_bind( + $sql, \@bind, + 'SELECT SUM(bar) AS "sum_bar" FROM "Foo" WHERE ( "foo" = ? ) HAVING ( "sum_bar" > ? )', [1,10], + 'group by / having (2)', +); + +#-limit alone +($sql, @bind) = $sqla->select( + -from => 'Foo', + -limit => 100 +); +is_same_sql_bind( + $sql, \@bind, + 'SELECT * FROM "Foo" LIMIT ? OFFSET ?', [100, 0], +); + +($sql, @bind) = $sqla->select( + -from => 'Foo', + -limit => 0, +); +is_same_sql_bind( + $sql, \@bind, + 'SELECT * FROM "Foo" LIMIT ? OFFSET ?', [0, 0], + 'limit 0', +); + + + +#-limit / -offset +($sql, @bind) = $sqla->select( + -from => 'Foo', + -limit => 100, + -offset => 300, +); +is_same_sql_bind( + $sql, \@bind, + 'SELECT * FROM "Foo" LIMIT ? OFFSET ?', [100, 300], +); + + +#-page_size / page_index +($sql, @bind) = $sqla->select( + -from => 'Foo', + -page_size => 50, + -page_index => 2, +); +is_same_sql_bind( + $sql, \@bind, + 'SELECT * FROM "Foo" LIMIT ? OFFSET ?', [50, 50], +); + + +# -for +($sql, @bind) = $sqla->select( + -from => 'Foo', + -for => 'UPDATE', +); +is_same_sql_bind( + $sql, \@bind, + 'SELECT * FROM "Foo" FOR UPDATE', [], +); + +# -want_details +my $details = $sqla->select( + -columns => [ qw/f.col1|c1 b.col2|c2 /], + -from => [-join => qw/Foo|f fk=pk Bar|b /], + -want_details => 1, +); +is_same_sql_bind( + $details->{sql}, $details->{bind}, + 'SELECT "f"."col1" AS "c1", "b"."col2" AS "c2" FROM "Foo" AS "f" INNER JOIN "Bar" AS "b" ON ( "f"."fk" = "b"."pk" )', [], +); +is_deeply($details->{aliased_tables}, {f => 'Foo', b => 'Bar'}, + 'aliased tables'); +is_deeply($details->{aliased_columns}, {c1 => 'f.col1', c2 => 'b.col2'}, + 'aliased columns'); + + +# aliasing, do not conflict with '||' operator +($sql, @bind) = $sqla->select( + -columns => [qw/A||B C||D|cd (E||F||G)|efg true|false|bool/], + -from => 'Foo', +); +is_same_sql_bind( + $sql, \@bind, + 'SELECT "A||B", "C||D" AS "cd", (E||F||G) AS "efg", "true|false" AS "bool" FROM "Foo"', [], + 'aliased cols with '|'' +); + +($sql, @bind) = $sqla->select( + -columns => [qw/(NULL)|a1 (2)|a2 x|a3/], + -from => 'Foo', +); +is_same_sql_bind( + $sql, \@bind, + 'SELECT (NULL) AS "a1", (2) AS "a2", "x" AS "a3" FROM "Foo"', [], + 'aliased cols with '|', single char on left-hand side' +); + + + +# bind_params with SQL types +($sql, @bind) = $sqla->select( + -from => 'Foo', + -where => {foo => [{dbd_attrs => {ora_type => 'TEST'}}, 123]}, + ); +is_same_sql_bind( + $sql, \@bind, + 'SELECT * FROM "Foo" WHERE "foo" = ?', + [ [{dbd_attrs => {ora_type => 'TEST'}}, 123] ], + 'SQL type with implicit = operator', +); + +($sql, @bind) = $sqla->select( + -from => 'Foo', + -where => {bar => {'<' => [{dbd_attrs => {pg_type => 999}}, 456]}}, + ); +is_same_sql_bind( + $sql, \@bind, + 'SELECT * FROM "Foo" WHERE "bar" < ?', + [ [{dbd_attrs => {pg_type => 999}}, 456] ], + 'SQL type with explicit operator', +); + + +($sql, @bind) = $sqla->insert( + -into => 'Foo', + -values => {x => [{dbd_attrs => {pg_type => 999}}, 456]}, + ); +is_same_sql_bind( + $sql, \@bind, + 'INSERT INTO "Foo"("x") VALUES(?)', + [ [{dbd_attrs => {pg_type => 999}}, 456] ], + 'INSERT with SQL type', +); + +($sql, @bind) = $sqla->update( + -table => 'Foo', + -set => {x => [{dbd_attrs => {pg_type => 999}}, 456]}, + -where => {bar => 'buz'}, + ); +is_same_sql_bind( + $sql, \@bind, + 'UPDATE "Foo" SET "x" = ? WHERE "bar" = ?', + [ [{dbd_attrs => {pg_type => 999}}, 456], 'buz' ], + 'UPDATE with SQL type', +); + + + +# should not be interpreted as bind_params with SQL types +($sql, @bind) = $sqla->select( + -from => 'Foo', + -where => {bar => [{'=' => undef}, {'<' => 'foo'}]} + ); +is_same_sql_bind( + $sql, \@bind, + 'SELECT * FROM "Foo" WHERE "bar" IS NULL OR "bar" < ?', + [ 'foo' ], + 'OR arrayref pair which is not a value/type pair', +); + + + +#---------------------------------------------------------------------- +# auxiliary methods : test an instance with standard parameters +#---------------------------------------------------------------------- + +($sql, @bind) = $sqla->column_alias(qw/Foo f/); +is_same_sql_bind( + $$sql, \@bind, + '"Foo" AS "f"', [], + 'column alias', +); + +($sql, @bind) = $sqla->column_alias(qw/Foo/); +is_same_sql_bind( + $sql, \@bind, + '"Foo"', [], + 'column alias without alias', +); + + +($sql, @bind) = $sqla->table_alias(qw/Foo f/); +is_same_sql_bind( + $sql, \@bind, + '"Foo" AS "f"', [], + 'table alias', +); + +($sql, @bind) = $sqla->limit_offset(123, 456); +is_same_sql_bind( + $sql, \@bind, + 'LIMIT ? OFFSET ?', [123, 456], + 'limit offset', +); + + +$join = $sqla->join(qw[Foo|f =>{fk_A=pk_A,fk_B=pk_B} Bar]); +is_same_sql_bind( + $join->{sql}, $join->{bind}, + '"Foo" AS "f" LEFT OUTER JOIN "Bar" ON ( ( "f"."fk_A" = "Bar"."pk_A" AND "f"."fk_B" = "Bar"."pk_B" ) )', [], + 'join syntax', +); + +$join = $sqla->join(qw[Foo <=>[A{sql}, $join->{bind}, + '"Foo" INNER JOIN "Bar" ON ( ( "Foo"."A" < "Bar"."B" OR "Foo"."C" < "Bar"."D" ) )', [], + 'join syntax with OR', +); + + +$join = $sqla->join(qw[Foo == Bar]); +is_same_sql_bind( + $join->{sql}, $join->{bind}, + '"Foo" NATURAL JOIN "Bar"', [], + 'natural join', +); + + +# try most syntactic constructs +$join = $sqla->join(qw[Table1|t1 ab=cd Table2|t2 + <=>{ef>gh,ij{t1.mn=op} Table4]); +is_same_sql_bind( + $join->{sql}, $join->{bind}, + '"Table1" AS "t1" INNER JOIN "Table2" AS "t2" ON ( "t1"."ab" = "t2"."cd" ) + INNER JOIN "Table3" ON ( ( "t2"."ef" > "Table3"."gh" + AND "t2"."ij" < "Table3"."kl" ) ) + LEFT OUTER JOIN "Table4" ON ( "t1"."mn" = "Table4"."op" )', + [], +); + + +# full outer join +$join = $sqla->join(qw[Foo >=<{a=b} Bar]); +is_same_sql_bind( + $join->{sql}, $join->{bind}, + '"Foo" FULL OUTER JOIN "Bar" ON ( "Foo"."a" = "Bar"."b" )', [], + 'full outer join', +); + + + +# explicit tables in join condition +$join = $sqla->join(qw[Table1|t1 t1.ab=t2.cd Table2|t2]); +is_same_sql_bind( + $join->{sql}, $join->{bind}, + '"Table1" AS "t1" INNER JOIN "Table2" AS "t2" ON ( "t1"."ab"="t2"."cd" )', + [], + 'explicit tables in join condition' + ); + + + +my $merged = $sqla->merge_conditions( + {a => 12, b => {'>' => 34}}, + {b => {'<' => 56}, c => 78}, + ); +is_deeply($merged, + {a => 12, b => [-and => {'>' => 34}, {'<' => 56}], c => 78}); + + +#---------------------------------------------------------------------- +# test a customized instance +#---------------------------------------------------------------------- + +$sqla = sqla(table_alias => '%1$s %2$s', + limit_offset => 'LimitXY', + sql_dialect => 'MsAccess', + ); + +$join = $sqla->join(qw[Foo|f =>{fk_A=pk_A,fk_B=pk_B} Bar]); +is_same_sql_bind( + $join->{sql}, $join->{bind}, + '"Foo" "f" LEFT OUTER JOIN ("Bar") ON ( ( "f"."fk_A" = "Bar"."pk_A" AND "f"."fk_B" = "Bar"."pk_B" ) )', [], +); + + +($sql, @bind) = $sqla->limit_offset(123, 456); +is_same_sql_bind( + $sql, \@bind, + 'LIMIT ?, ?', [456, 123] +); + + +ok($sqla->join_assoc_right, + 'join_assoc_right is true'); + + +$sqla = sqla(sql_dialect => 'Oracle'); +($sql, @bind) = $sqla->select( + -columns => [qw/col1|c1 col2|c2/], + -from => [-join => qw/Foo|f fk=pk Bar|b/], +); +is_same_sql_bind( + $sql, \@bind, + 'SELECT "col1" "c1", "col2" "c2" FROM "Foo" "f" INNER JOIN "Bar" "b" ON ( "f"."fk" = "b"."pk" )', + [] +); + +($sql, @bind) = $sqla->select( + -from => 'Foo', + -limit => 10, + -offset => 5, +); + +is_same_sql_bind( + $sql, \@bind, + 'SELECT * FROM (SELECT subq_A.*, ROWNUM rownum__index FROM (SELECT * FROM "Foo") subq_A WHERE ROWNUM <= ?) subq_B WHERE rownum__index >= ?', + [15, 6], +); + + + +# Oracle12c version of limit/offset +$sqla = sqla( sql_dialect => 'Oracle12c' ); +($sql, @bind) = $sqla->limit_offset(123, 456); +is_same_sql_bind( + $sql, \@bind, + 'OFFSET ? ROWS FETCH NEXT ? ROWS ONLY', + [456, 123], + 'limit/offset for Oracle12c', +); + + +#---------------------------------------------------------------------- +# method redefinition +#---------------------------------------------------------------------- + +$sqla = sqla( + limit_offset => sub { + my ($self, $limit, $offset) = @_; + defined $limit or die 'NO LIMIT!'; + $offset ||= 0; + my $last = $offset + $limit; + return ('ROWS ? TO ?', $offset, $last); # ($sql, @bind) + }); + + +($sql, @bind) = $sqla->limit_offset(123, 456); +is_same_sql_bind( + $sql, \@bind, + 'ROWS ? TO ?', [456, 579] +); + + +#---------------------------------------------------------------------- +# max_members_IN +#---------------------------------------------------------------------- + +$sqla = sqla( + max_members_IN => 10 + ); + +my @vals = (1 .. 35); +($sql, @bind) = $sqla->where({foo => {-in => \@vals}}); + +is_same_sql_bind( + $sql, \@bind, + ' WHERE ( ( "foo" IN ( ?, ?, ?, ?, ?, ?, ?, ?, ?, ? ) ' + . ' OR "foo" IN ( ?, ?, ?, ?, ?, ?, ?, ?, ?, ? ) ' + . ' OR "foo" IN ( ?, ?, ?, ?, ?, ?, ?, ?, ?, ? ) ' + . ' OR "foo" IN ( ?, ?, ?, ?, ?) ) )', + [1 .. 35] +); + + +($sql, @bind) = $sqla->where({foo => {-not_in => \@vals}}); +is_same_sql_bind( + $sql, \@bind, + ' WHERE ( ( "foo" NOT IN ( ?, ?, ?, ?, ?, ?, ?, ?, ?, ? ) ' + . ' AND "foo" NOT IN ( ?, ?, ?, ?, ?, ?, ?, ?, ?, ? ) ' + . ' AND "foo" NOT IN ( ?, ?, ?, ?, ?, ?, ?, ?, ?, ? ) ' + . ' AND "foo" NOT IN ( ?, ?, ?, ?, ?) ) )', + [1 .. 35] +); + +$sqla = sqla( + max_members_IN => 3 + ); + +($sql, @bind) = $sqla->where({foo => {-in => [1 .. 5]}, + bar => {-not_in => [6 .. 10]}}); +is_same_sql_bind( + $sql, \@bind, + ' WHERE ( ( ( "bar" NOT IN ( ?, ?, ? ) AND "bar" NOT IN ( ?, ? ) )' + . ' AND ( "foo" IN ( ?, ?, ? ) OR "foo" IN ( ?, ? ) ) ) )', + [6 .. 10, 1 .. 5] +); + +# test old API : passing a plain scalar value to -in +($sql, @bind) = $sqla->where({foo => {-in => 123}}); +is_same_sql_bind( + $sql, \@bind, + ' WHERE ( "foo" IN (?) )', + [123], +); + + +#---------------------------------------------------------------------- +# -in with objects +#---------------------------------------------------------------------- + +$sqla = sqla (); +my $vals = bless [1, 2], 'Array::PseudoScalar'; # doesn't matter if not loaded + +($sql, @bind) = $sqla->where({foo => {-in => $vals}, + bar => {-not_in => $vals}}); + +is_same_sql_bind( + $sql, \@bind, + ' WHERE ( ( "bar" NOT IN ( ?, ? ) AND "foo" IN ( ?, ? ) ) )', + [1, 2, 1, 2], +); + + +#---------------------------------------------------------------------- +# select_implicitly_for +#---------------------------------------------------------------------- + +my $sqla_RO = sqla( + select_implicitly_for => 'READ ONLY', + ); + +($sql, @bind) = $sqla_RO->select(-from => 'Foo'); +is_same_sql_bind( + $sql, \@bind, + 'SELECT * FROM "FOO" FOR READ ONLY', [], + 'select_implicitly_for - basic', +); + +($sql, @bind) = $sqla_RO->select(-from => 'Foo', -for => 'UPDATE'); +is_same_sql_bind( + $sql, \@bind, + 'SELECT * FROM "FOO" FOR UPDATE', [], + 'select_implicitly_for - override', +); + +($sql, @bind) = $sqla_RO->select(-from => 'Foo', -for => undef); +is_same_sql_bind( + $sql, \@bind, + 'SELECT * FROM "FOO"', [], + 'select_implicitly_for - disable', +); + + + +#---------------------------------------------------------------------- +# insert +#---------------------------------------------------------------------- + +# usual, hashref syntax +($sql, @bind) = $sqla->insert( + -into => 'Foo', + -values => {foo => 1, bar => 2}, +); +is_same_sql_bind( + $sql, \@bind, + 'INSERT INTO "Foo" ( "bar", "foo" ) VALUES (?, ?)', + [2, 1], + 'insert - hashref', +); + +# arrayref syntax +($sql, @bind) = $sqla->insert( + -into => 'Foo', + -values => [1, 2], +); +is_same_sql_bind( + $sql, \@bind, + 'INSERT INTO "Foo" VALUES (?, ?)', + [1, 2], + 'insert - arrayref', +); + + +# insert .. select +($sql, @bind) = $sqla->insert( + -into => 'Foo', + -columns => [qw/a b/], + -select => {-from => 'Bar', -columns => [qw/x y/]}, +); +is_same_sql_bind( + $sql, \@bind, + 'INSERT INTO "Foo"("a", "b") SELECT "x", "y" FROM "Bar"', + [], + 'insert .. select', +); + + + + +# old API +($sql, @bind) = $sqla->insert('Foo', {foo => 1, bar => 2}); +is_same_sql_bind( + $sql, \@bind, + 'INSERT INTO "Foo" ( "bar", "foo" ) VALUES (?, ?)', + [2, 1], +); + +($sql, @bind) = eval {$sqla->insert(-foo => 3); }; +ok($@, 'unknown arg to insert()'); + +# add_sql +($sql, @bind) = $sqla->insert( + -into => 'Foo', + -add_sql => 'IGNORE', # MySQL syntax + -values => {foo => 1, bar => 2}, +); +is_same_sql_bind( + $sql, \@bind, + 'INSERT IGNORE INTO "Foo" ( "bar", "foo" ) VALUES (?, ?)', + [2, 1], +); +($sql, @bind) = $sqla->insert( + -into => 'Foo', + -add_sql => 'OR IGNORE', # SQLite syntax + -values => {foo => 1, bar => 2}, +); +is_same_sql_bind( + $sql, \@bind, + 'INSERT OR IGNORE INTO "Foo" ( "bar", "foo" ) VALUES (?, ?)', + [2, 1], +); + + + +# returning +($sql, @bind) = $sqla->insert( + -into => 'Foo', + -values => {foo => 1, bar => 2}, + -returning => 'key', +); +is_same_sql_bind( + $sql, \@bind, + 'INSERT INTO "Foo" ( "bar", "foo" ) VALUES (?, ?) RETURNING "key"', + [2, 1], +); + +($sql, @bind) = $sqla->insert( + -into => 'Foo', + -values => {foo => 1, bar => 2}, + -returning => [qw/k1 k2/], +); +is_same_sql_bind( + $sql, \@bind, + 'INSERT INTO "Foo" ( "bar", "foo" ) VALUES (?, ?) RETURNING "k1", "k2"', + [2, 1], +); + +($sql, @bind) = $sqla->insert( + -into => 'Foo', + -values => {foo => 1, bar => 2}, + -returning => {k1 => \my $k1, k2 => \my $k2}, +); +is_same_sql_bind( + $sql, \@bind, + 'INSERT INTO "Foo" ( "bar", "foo" ) VALUES (?, ?) RETURNING "k1", "k2" INTO ?, ?', + [2, 1, \$k2, \$k1], +); + + + + +# bind_params + +SKIP: { + eval 'use DBD::Mock 1.48; 1' + or skip 'DBD::Mock 1.48 does not seem to be installed', N_DBI_MOCK_TESTS; + + my $dbh = DBI->connect('DBI:Mock:', '', '', {RaiseError => 1}); + my $sth = $dbh->prepare($sql); + $sqla->bind_params($sth, @bind); + my $mock_params = $sth->{mock_params}; + is_deeply($sth->{mock_params}, [2, 1, \$k2, \$k1], 'bind_param_inout'); + + # test 3-args form of bind_param + $sth = $dbh->prepare('INSERT INTO Foo(bar, foo) VALUES (?, ?)'); + @bind= ([{dbd_attrs => {pg_type => 99}}, 123], + [{dbd_attrs => {ora_type => 88}}, 456]); + $sqla->bind_params($sth, @bind); + is_deeply($sth->{mock_params}, + [map {$_->[1]} @bind], + 'bind_param($val, \%type) - values'); + is_deeply($sth->{mock_param_attrs}, + [map {$_->[0]{dbd_attrs}} @bind], + 'bind_param($val, \%type) - attrs'); +} + + +#---------------------------------------------------------------------- +# update +#---------------------------------------------------------------------- + +# complete syntax +($sql, @bind) = $sqla->update( + -table => 'Foo', + -set => {foo => 1, bar => 2}, + -where => {buz => 3}, +); +is_same_sql_bind( + $sql, \@bind, + 'UPDATE "Foo" SET "bar" = ?, "foo" = ? WHERE ( "buz" = ? )', + [2, 1, 3], +); + +# without where +($sql, @bind) = $sqla->update( + -table => 'Foo', + -set => {foo => 1, bar => 2}, +); +is_same_sql_bind( + $sql, \@bind, + 'UPDATE "Foo" SET "bar" = ?, "foo" = ?', + [2, 1], +); + +# old API +($sql, @bind) = $sqla->update('Foo', {foo => 1, bar => 2}, {buz => 3}); +is_same_sql_bind( + $sql, \@bind, + 'UPDATE "Foo" SET "bar" = ?, "foo" = ? WHERE ( "buz" = ? )', + [2, 1, 3], +); + +# support for table aliases +($sql, @bind) = $sqla->update( + -table => 'Foo|a', + -set => {'a.foo' => 1, 'a.bar' => 2}, + -where => {'a.buz' => 3}, +); +is_same_sql_bind( + $sql, \@bind, + 'UPDATE "Foo" AS "a" SET "a"."bar" = ?, "a"."foo" = ? WHERE ( "a"."buz" = ? )', + [2, 1, 3], +); + +# MySQL supports -limit and -order_by in updates ! +# see http://dev.mysql.com/doc/refman/5.6/en/update.html +($sql, @bind) = $sqla->update( + -table => 'Foo', + -set => {foo => 1, bar => 2}, + -where => {buz => 3}, + -order_by => 'baz', + -limit => 10, +); +is_same_sql_bind( + $sql, \@bind, + 'UPDATE "Foo" SET "bar" = ?, "foo" = ? WHERE ( "buz" = ? ) ORDER BY "baz" LIMIT ?', + [2, 1, 3, 10], + 'update with -order_by/-limit', +); + +($sql, @bind) = $sqla->update( + -table => [-join => qw/Foo fk=pk Bar/], + -set => {foo => 1, bar => 2}, +); +is_same_sql_bind( + $sql, \@bind, + 'UPDATE "Foo" INNER JOIN "Bar" ON ( "Foo"."fk" = "Bar"."pk" ) SET "bar" = ?, "foo" = ?', + [2, 1], +); + + + + +# returning +($sql, @bind) = $sqla->update( + -table => 'Foo', + -set => {foo => 1}, + -returning => 'key', +); +is_same_sql_bind( + $sql, \@bind, + 'UPDATE "Foo" SET "foo" = ? RETURNING "key"', + [1], + 'update returning (scalar)', +); + +($sql, @bind) = $sqla->update( + -table => 'Foo', + -set => {foo => 1}, + -returning => [qw/k1 k2/], +); +is_same_sql_bind( + $sql, \@bind, + 'UPDATE "Foo" SET "foo" = ? RETURNING "k1", "k2"', + [1], + 'update returning (arrayref)', +); + +($sql, @bind) = $sqla->update( + -table => 'Foo', + -set => {foo => 1}, + -returning => {k1 => \my $kupd1, k2 => \my $kupd2}, +); +is_same_sql_bind( + $sql, \@bind, + 'UPDATE "Foo" SET "foo" = ? RETURNING "k1", "k2" INTO ?, ?', + [1, \$kupd1, \$kupd2], + 'update returning (hashref)', +); + + + +# additional keywords +($sql, @bind) = $sqla->update( + -add_sql => 'IGNORE', # MySQL syntax + -table => 'Foo', + -set => {foo => 1}, + +); +is_same_sql_bind( + $sql, \@bind, + 'UPDATE IGNORE "Foo" SET "foo" = ?', + [1], + 'update IGNORE', +); + + + + +#---------------------------------------------------------------------- +# delete +#---------------------------------------------------------------------- + +# complete syntax +($sql, @bind) = $sqla->delete( + -from => 'Foo', + -where => {buz => 3}, +); +is_same_sql_bind( + $sql, \@bind, + 'DELETE FROM "Foo" WHERE "buz" = ?', + [3], + 'delete', +); + +# old API +($sql, @bind) = $sqla->delete('Foo', {buz => 3}); +is_same_sql_bind( + $sql, \@bind, + 'DELETE FROM "Foo" WHERE "buz" = ?', + [3], + 'delete, old API', +); + +# support for table aliases +($sql, @bind) = $sqla->delete( + -from => 'Foo|a', + -where => {buz => 3}, +); +is_same_sql_bind( + $sql, \@bind, + 'DELETE FROM "Foo" AS "a" WHERE "buz" = ?', + [3], + 'delete with table alias', +); + +# MySQL supports -limit and -order_by in deletes ! +# see http://dev.mysql.com/doc/refman/5.6/en/delete.html +($sql, @bind) = $sqla->delete( + -from => 'Foo', + -where => {buz => 3}, + -order_by => 'baz', + -limit => 10, +); +is_same_sql_bind( + $sql, \@bind, + 'DELETE FROM "Foo" WHERE ( "buz" = ? ) ORDER BY "baz" LIMIT ?', + [3, 10], + 'delete with -order_by/-limit', +); + + +# additional keywords +($sql, @bind) = $sqla->delete( + -from => 'Foo', + -where => {buz => 3}, + -add_sql => 'IGNORE', # MySQL syntax + +); +is_same_sql_bind( + $sql, \@bind, + 'DELETE IGNORE FROM "Foo" WHERE ( "buz" = ? )', + [3], + 'delete with -add_sql', +); + + + + +#---------------------------------------------------------------------- +# quote +#---------------------------------------------------------------------- + +($sql, @bind) = $sqla->select( + -from => [ + -join => qw( + t1|left + id=t1_id + t2|link + =>{t3_id=id} + t3|right + ) + ], + -columns => [ qw( + left.id|left_id + max("right"."id")|max_right_id + ) ] + ); + +is_same_sql_bind( + $sql, \@bind, + 'SELECT "left"."id" AS "left_id", max("right"."id") AS "max_right_id" ' + . 'FROM "t1" AS "left" ' + . 'INNER JOIN "t2" AS "link" ON ( "left"."id" = "link"."t1_id" ) ' + . 'LEFT OUTER JOIN "t3" AS "right" ON ( "link"."t3_id" = "right"."id" )', + + [], +); + +#---------------------------------------------------------------------- +# quote table name +#---------------------------------------------------------------------- + +($sql, @bind) = $sqla->select( + -from => 'Foo|Bar', + -columns => 'a|b' +); + +is_same_sql_bind( + $sql, \@bind, + 'SELECT "a" AS "b" FROM "Foo" AS "Bar"', + [], +); + +($sql, @bind) = $sqla->delete( + -from => 'Foo|Bar', + -where => { a => 3 }, +); + +is_same_sql_bind( + $sql, \@bind, + 'DELETE FROM "Foo" AS "Bar" WHERE ( "a" = ? )', + [3], +); + +($sql, @bind) = $sqla->update( + -table => 'Foo|Bar', + -set => { b => 2 }, + -where => { a => 3 }, +); + +is_same_sql_bind( + $sql, \@bind, + 'UPDATE "Foo" AS "Bar" SET "b" = ? WHERE ( "a" = ? )', + [2, 3], +); + + +#---------------------------------------------------------------------- +# CTE +#---------------------------------------------------------------------- + +$sqla = sqla()->with( + -table => 't2', + -columns => [ 'store', 'avg_order' ], + -as_select => { + -from => 'Table1', + -columns => [ 'store', 'average_order' ], + -group_by => 'store', + } +); + +($sql, @bind ) = $sqla->select( + -from => [ -join => qw/Table1|t1 {store} t2/ ], + -columns => [ 't1.id', 't2.avg_order|avg' ], +); + +is_same_sql_bind( + $sql, \@bind, +q{WITH t2 ("store","avg_order") AS + (SELECT "store", "average_order" + FROM "table1" + GROUP BY "store") +SELECT "t1"."id", "t2"."avg_order" AS "avg" +FROM "Table1" AS "t1" +INNER JOIN "t2" USING("store") +}, +[] +); + + +#---------------------------------------------------------------------- +# THE END +#---------------------------------------------------------------------- + + +done_testing(); From 821853c2ddd207a148f01a79d07b8cbc656b372c Mon Sep 17 00:00:00 2001 From: Diab Jerius Date: Sat, 2 Aug 2025 16:09:12 -0400 Subject: [PATCH 2/2] better handle quoted columns and tables Tables and columns were not properly quoted in all instances when the quote_char constructor option is set. Some were underquoted, some over quooted, and some table expressions were quoted. This lead iin the latter cases to illegal SQL. The intrinsic problem lies with treating them as strings, rather than as objects, so there is no "quote" or "quotable" state assigned to a given SQL fragment. The code has to rely upon heuristics to know when to quote (e.g. a bare identifier) and when not to quote (interpolation of an SQL expression). This requires carrying external state (e.g., the new is_literal flag from _parse_table and in the return from table_alias), and informing the quoting apparati in table_alias() and column_alias() of whether quoting is permissible via the "quote_name" and "quote_aliased_name" options. --- lib/SQL/Abstract/More.pm | 208 ++++++++++++++++++++++++++++++++++----- 1 file changed, 181 insertions(+), 27 deletions(-) diff --git a/lib/SQL/Abstract/More.pm b/lib/SQL/Abstract/More.pm index 2ee9f05..abe76b6 100644 --- a/lib/SQL/Abstract/More.pm +++ b/lib/SQL/Abstract/More.pm @@ -19,7 +19,7 @@ use namespace::clean; # declare error-reporting functions from SQL::Abstract sub puke(@); sub belch(@); # these will be defined later in import() -our $VERSION = '1.44'; +our $VERSION = '1.44_01'; our @ISA; sub import { @@ -318,7 +318,7 @@ sub with { my ($sql, @bind) = $self->select(%{$args{-as_select}}); $clone->{WITH}{sql} .= ", " if $clone->{WITH}{sql}; $clone->{WITH}{sql} .= $args{-table}; - $clone->{WITH}{sql} .= "(" . join(", ", @cols) . ")" if @cols; + $clone->{WITH}{sql} .= "(" . join(", ", map { $self->_quote($_) } @cols) . ")" if @cols; $clone->{WITH}{sql} .= " AS ($sql) "; $clone->{WITH}{sql} .= $args{-final_clause} . " " if $args{-final_clause}; push @{$clone->{WITH}{bind}}, @bind; @@ -361,11 +361,14 @@ sub select { # parse columns and datasource my ($cols, $post_select, $cols_bind, $aliased_columns) = $self->_parse_columns($args{-columns}); - my ($from, $from_bind, $aliased_tables) = $self->_parse_from($args{-from}); + my ($from, $from_bind, $aliased_tables, $is_literal) = $self->_parse_from($args{-from}); $add_sql_bind->("", @$cols_bind, @$from_bind); + # our columns are already appropriately quoted, so prevent SQLA from + # double quoting + $cols = CORE::join( ', ', map { ref $_ ? $$_ : $_ } @$cols ); # generate main ($sql, @bind) through the old positional API - $add_sql_bind->($self->next::method($from, $cols, $args{-where})); + $add_sql_bind->($self->next::method($is_literal ? \$from : $from, $cols, $args{-where})); # add @post_select clauses if needed (for ex. -distinct) my $all_post_select = join " ", @$post_select; @@ -374,7 +377,8 @@ sub select { # add set operators (UNION, INTERSECT, etc) if needed foreach my $set_op (@set_operators) { if (my $val_set_op = $args{-$set_op}) { - my ($sql_set_op, @bind_set_op) = $self->_parse_set_operator($set_op => $val_set_op, $cols, $from); + # pass original columns spec instead of $cols, or they may be multiply quoted. + my ($sql_set_op, @bind_set_op) = $self->_parse_set_operator($set_op => $val_set_op, $args{-columns}, $from); $add_sql_bind->($sql_set_op, @bind_set_op); } } @@ -432,6 +436,15 @@ sub select { } +# return true if column should be quoted. +sub _quotable_identifier { + my ( $name ) = @_; + + # quote $name unless it is an SQL expression (then the user should quote it) + $name !~ /[()]/; +} + + sub _parse_columns { my ($self, $columns) = @_; @@ -448,11 +461,20 @@ sub _parse_columns { my %aliased_columns; foreach my $col (@cols) { + # columns which are scalar refs are literal SQL and don't require + # processing. + next if does( $col, 'SCALAR' ); + + my $quote_name = 1; + # deal with subquery of shape \ [$sql, @bind] if (_is_subquery($col)) { my ($sql, @col_bind) = @$$col; $sql =~ s{^(select.*)}{($1)}is; # if subquery is a plain SELECT, put it in parenthesis $col = $sql; + + # $col is an expression, so don't quote it. + $quote_name = 0; push @cols_bind, @col_bind; } @@ -464,7 +486,12 @@ sub _parse_columns { \s* # ignore insignificant trailing spaces $/x) { $aliased_columns{$2} = $1; - $col = $self->column_alias($1, $2); + $col = $self->column_alias($1, $2, $quote_name); + } + + # bare column; quote if required + else { + $col = $self->_quote($col) if $quote_name && _quotable_identifier( $col ); } } @@ -477,6 +504,8 @@ sub _parse_from { my @from_bind; my $aliased_tables = {}; + my $is_literal = 0; + my $quote_aliased_name = 1; my $join_info = $self->_compute_join_info($from); if ($join_info) { @@ -484,6 +513,25 @@ sub _parse_from { @from_bind = @{$join_info->{bind}}; $aliased_tables = $join_info->{aliased_tables}; } + + # compatibility with old SQL::Abstract syntax for $source + elsif (does($from, 'ARRAY')) { + my @from; + my @aliased_tables; + + # array elements may need to be quoted/aliased + for my $table ( @$from ) { + my $table_spec = $self->_parse_table($table); + my $sql = $table_spec->{sql}; + push @from, $table_spec->{is_literal} ? $sql : $self->_quote($sql); + push @aliased_tables, %{ $table_spec->{aliased_tables} }; + } + $from = join ", ", @from; + $aliased_tables = { @aliased_tables }; + + # this is now the final SQL, should not be further quoted. + $is_literal = 1; + } else { # if -from is a subquery, separate the $sql and @bind parts @@ -491,23 +539,23 @@ sub _parse_from { my ($sql, @bind) = @$$from; $sql =~ s{^(\s*select.*)}{($1)}is; # if subquery is a plain SELECT, put it in parenthesis $from = $sql; + + # $sql is an expression, so _parse_table (called below) shouldn't quote it. + $quote_aliased_name = 0; push @from_bind, @bind; } - # conditions below : compatibility with old SQL::Abstract syntax for $source - elsif (does($from, 'ARRAY')) { - $from = join ", ", @$from; - } elsif (does($from, 'SCALAR')) { $from = $$from; } - my $table_spec = $self->_parse_table($from); + my $table_spec = $self->_parse_table($from, quote_aliased_name => $quote_aliased_name); $from = $table_spec->{sql}; + $is_literal = $table_spec->{is_literal}; $aliased_tables = $table_spec->{aliased_tables}; } - return ($from, \@from_bind, $aliased_tables); + return ($from, \@from_bind, $aliased_tables, $is_literal); } @@ -679,7 +727,10 @@ sub insert { my ($sql, @bind) = $self->select(%{$args{-select}}); $old_API_args[1] = \ [$sql, @bind]; if (my $cols = $args{-columns}) { - $old_API_args[0] .= "(" . CORE::join(", ", @$cols) . ")"; + $old_API_args[0] = + \( $self->_quote($old_API_args[0]) . + "(" . CORE::join(", ", map { $self->_quote($_) } @$cols) . ")" + ); } $fix_RT134127 = 1 if ($SQL::Abstract::VERSION || 0) >= 2.0; } @@ -884,7 +935,7 @@ sub update { # compute SQL for datasource to be updated $join_info = $self->_compute_join_info($args{-table}); $args{-table} = defined $join_info ? \($join_info->{sql}) - : $self->_parse_table($args{-table})->{sql}; + : \($self->_parse_table($args{-table}, quote_name => 1)->{sql}); @old_API_args = @args{qw/-table -set -where/}; @@ -932,7 +983,9 @@ sub delete { my %args; if (&_called_with_named_args) { %args = validate(@_, \%params_for_delete); - $args{-from} = $self->_parse_table($args{-from})->{sql}; + # this will always return literal (possibly quoted) SQL, so don't + # further quote it. + $args{-from} = \($self->_parse_table($args{-from}, quote_name => 1)->{sql}); @old_API_args = @args{qw/-from -where/}; } else { @@ -1055,7 +1108,7 @@ sub join { # shift first single item (a table) before reducing pairs (op, table) my $combined = shift; - $combined = $self->_parse_table($combined) unless ref $combined; + $combined = $self->_parse_table($combined, quote_name => 1) unless ref $combined; # reduce pairs (op, table) while (@_) { @@ -1064,7 +1117,7 @@ sub join { my $table_spec = shift or puke "improper number of operands"; $join_spec = $self->_parse_join_spec($join_spec) unless ref $join_spec; - $table_spec = $self->_parse_table($table_spec) unless ref $table_spec; + $table_spec = $self->_parse_table($table_spec, quote_name => 1) unless ref $table_spec; $combined = $self->_single_join($combined, $join_spec, $table_spec); } @@ -1167,18 +1220,104 @@ sub _compute_join_info { } } +=for documentation + +=head3 _parse_table + + \%spec = $sqla->_parse_table( $table_spec, %args ); + +Parse a table specification C<$table_spec>, as a string, which +consists of a + + * a table name or an expression (such as a select); + + * an optional alias + +The two elements are separated by the C<|> character. + +C<%args> may contain the following entries: + +=over + +=item quote_aliased_name => boolean + +If the specification contains an alias, quote the table name in addition to the alias (the alias +will always be quoted). When this is set, the caller must ensure that the table name is not +an expression, otherwise incorrect SQL will be produced. + +=item quote_name => boolean + +Always quote the table name, whether or not it is aliased. When this +is set, the caller must ensure that the table name is not an +expression, otherwise incorrect SQL will be produced. + +=back + +Returns a hash with the entries: + +=over + +=back + +The "sql"' element may be fully or partially quoted; this decision is +up to the calling routine, which must understand the context in which the +"sql" element is used. + +For example, if the table specification elements are |, +then the "aliased name" () should not be quoted, and the +quote_aliased_name option should be false. + +If the resultant sql is to be directly embedded into a string, then + +=over + +=item sql => string + +SQL for the table name or expression which may be interpolated. Note +that if the passed table specification does not include an alias and +the L is not set the resultant SQL will not contain a quoted +table name/expression. The caller must decide if this is appropriate for the +context in which the parsed table specification is used. + +=item bind => array + +SQL bind values. + +=item name => string + +The table name or expression, or if an alias was provided, the alias. +This will not be quoted. + +=item aliased_tables => \%hash + +A hash keyed off of the unquoted alias, with the unquoted table name/expression as the value. + +=item is_literal => boolean + +True if the SQL hould be interpolated as-is, without further quotation. + +=back + +=cut + sub _parse_table { - my ($self, $table) = @_; + my ($self, $table) = ( shift, shift ); + my %args = ( + quote_aliased_name => 1, + quote_name => 0, + @_ + ); # extract alias, if any (recognized as "table|alias") ($table, my $alias) = split /\|/, $table, 2; # build a table spec return { - sql => $self->table_alias($table, $alias), + sql => $self->table_alias($table, $alias, %args ), bind => [], name => ($alias || $table), aliased_tables => {$alias ? ($alias => $table) : ()}, + is_literal => $args{quote_name} && _quotable_identifier($table) || defined $alias, }; } @@ -1263,13 +1402,13 @@ sub _single_join { or puke "join specification has both {condition} and {using} fields"; $syntax =~ s/\bON\s+%s/USING (%s)/; - $sql = CORE::join ",", @{$join_spec->{using}}; + $sql = CORE::join ",", map { $self->_parse_table( $_, quote_name => 1 )->{sql} } @{$join_spec->{using}}; } elsif ($join_spec->{condition}) { not $join_spec->{using} or puke "join specification has both {condition} and {using} fields"; - # compute the "ON" clause + # compute the "ON" clause; this handles quoting of table names ($sql, @bind) = $self->where($join_spec->{condition}); $sql =~ s/^\s*WHERE\s+//; @@ -1479,11 +1618,14 @@ sub _make_sub_column_alias { my ($self) = @_; my $syntax = $self->{column_alias}; $self->{column_alias} = sub { - my ($self, $name, $alias) = @_; - return $name if !$alias; + my ($self, $name, $alias, $quote_name) = @_; + + $quote_name = 1 if ! defined $quote_name; # quote $name unless it is an SQL expression (then the user should quote it) - $name = $self->_quote($name) unless $name =~ /[()]/; + $name = $self->_quote($name) if $quote_name && _quotable_identifier( $name ); + + return $name if !$alias; # assemble syntax my $sql = sprintf $syntax, $name, $self->_quote($alias); @@ -1498,11 +1640,23 @@ sub _make_sub_table_alias { my ($self) = @_; my $syntax = $self->{table_alias}; $self->{table_alias} = sub { - my ($self, $name, $alias) = @_; - return $name if !$alias; + my ($self, $name, $alias ) = (shift, shift, shift ); + + my %args = ( + quote_aliased_name => 1, + quote_name => 0, + @_, + ); + $args{quote_aliased_name} &&= _quotable_identifier( $name ); + $args{quote_name} &&= _quotable_identifier( $name ); + + # quote $name unless it is an SQL expression (then the user should quote it) + return $args{quote_name} ? $self->_quote($name) : $name if !$alias; # assemble syntax - my $sql = sprintf $syntax, $self->_quote($name), $self->_quote($alias); + my $sql = sprintf $syntax, + ( $args{quote_aliased_name} ? $self->_quote($name) : $name ), + $self->_quote($alias); return $sql; };