[Bast-commits] r8539 - in SQL-Abstract/1.x/branches/arbitrary_op_nesting: . lib/SQL lib/SQL/Abstract t

ribasushi at dev.catalyst.perl.org ribasushi at dev.catalyst.perl.org
Thu Feb 4 14:04:00 GMT 2010


Author: ribasushi
Date: 2010-02-04 14:03:59 +0000 (Thu, 04 Feb 2010)
New Revision: 8539

Modified:
   SQL-Abstract/1.x/branches/arbitrary_op_nesting/
   SQL-Abstract/1.x/branches/arbitrary_op_nesting/Changes
   SQL-Abstract/1.x/branches/arbitrary_op_nesting/lib/SQL/Abstract.pm
   SQL-Abstract/1.x/branches/arbitrary_op_nesting/lib/SQL/Abstract/Test.pm
   SQL-Abstract/1.x/branches/arbitrary_op_nesting/t/01generate.t
   SQL-Abstract/1.x/branches/arbitrary_op_nesting/t/05in_between.t
   SQL-Abstract/1.x/branches/arbitrary_op_nesting/t/07subqueries.t
   SQL-Abstract/1.x/branches/arbitrary_op_nesting/t/10test.t
Log:
 r8476 at Thesaurus (orig r8463):  ribasushi | 2010-01-28 12:14:12 +0100
 optional functionality for INSERT
 implementation of INSERT ... RETURNING 
 r8549 at Thesaurus (orig r8536):  ribasushi | 2010-02-04 14:36:51 +0100
  r6975 at Thesaurus (orig r6974):  ribasushi | 2009-07-03 20:24:27 +0200
  New branch to work on SQLA::Test
  r6976 at Thesaurus (orig r6975):  frew | 2009-07-03 20:43:17 +0200
  Add non-equality tests for ordered lists
  r6977 at Thesaurus (orig r6976):  frew | 2009-07-03 20:46:43 +0200
  count(*), count(a) and count(0) should not be equivalent
  r8542 at Thesaurus (orig r8529):  ribasushi | 2010-02-04 11:46:09 +0100
  Enhance/detabify
  r8546 at Thesaurus (orig r8533):  ribasushi | 2010-02-04 14:23:16 +0100
  Things look saner now
 
 r8551 at Thesaurus (orig r8538):  ribasushi | 2010-02-04 14:41:59 +0100
 Release ready - still need to coordinate with DBIC



Property changes on: SQL-Abstract/1.x/branches/arbitrary_op_nesting
___________________________________________________________________
Name: svk:merge
   - b9bda2dc-4395-4011-945f-8c81d782bde1:/branches/matthewt:18
b9bda2dc-4395-4011-945f-8c81d782bde1:/trunk:23
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/SQL-Abstract/1.x/branches/and_or:6008
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/SQL-Abstract/1.x/branches/bool_operator:7524
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/SQL-Abstract/1.x/branches/special_op_handling:6158
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/trunk/SQL-Abstract:3093
   + b9bda2dc-4395-4011-945f-8c81d782bde1:/branches/matthewt:18
b9bda2dc-4395-4011-945f-8c81d782bde1:/trunk:23
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/SQL-Abstract/1.x/branches/and_or:6008
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/SQL-Abstract/1.x/branches/bool_operator:7524
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/SQL-Abstract/1.x/branches/special_op_handling:6158
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/SQL-Abstract/1.x/branches/test_refactor:8533
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/SQL-Abstract/1.x/trunk:8538
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/trunk/SQL-Abstract:3093

Modified: SQL-Abstract/1.x/branches/arbitrary_op_nesting/Changes
===================================================================
--- SQL-Abstract/1.x/branches/arbitrary_op_nesting/Changes	2010-02-04 13:41:59 UTC (rev 8538)
+++ SQL-Abstract/1.x/branches/arbitrary_op_nesting/Changes	2010-02-04 14:03:59 UTC (rev 8539)
@@ -1,5 +1,9 @@
 Revision history for SQL::Abstract
 
+    - Allow INSERT to take additional attributes
+    - Support for INSERT ... RETURNING
+    - 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

Modified: SQL-Abstract/1.x/branches/arbitrary_op_nesting/lib/SQL/Abstract/Test.pm
===================================================================
--- SQL-Abstract/1.x/branches/arbitrary_op_nesting/lib/SQL/Abstract/Test.pm	2010-02-04 13:41:59 UTC (rev 8538)
+++ SQL-Abstract/1.x/branches/arbitrary_op_nesting/lib/SQL/Abstract/Test.pm	2010-02-04 14:03:59 UTC (rev 8539)
@@ -40,6 +40,7 @@
   )',
   'ON',
   'WHERE',
+  'EXISTS',
   'GROUP \s+ BY',
   'HAVING',
   'ORDER \s+ BY',
@@ -49,6 +50,7 @@
   'UNION',
   'INTERSECT',
   'EXCEPT',
+  'RETURNING',
 );
 
 # These are binary operator keywords always a single LHS and RHS
@@ -57,11 +59,14 @@
 # * 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' }
@@ -74,7 +79,7 @@
   @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 = (
@@ -215,7 +220,7 @@
     _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);
@@ -223,7 +228,7 @@
     }
     # 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);
@@ -245,10 +250,7 @@
   # 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);
@@ -276,7 +278,7 @@
     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);
@@ -301,9 +303,9 @@
       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);
       }
@@ -325,10 +327,11 @@
                     : [[ $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)||()] ];
     }
   }
 }
@@ -372,23 +375,23 @@
         $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++;
@@ -415,7 +418,7 @@
   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') {

Modified: SQL-Abstract/1.x/branches/arbitrary_op_nesting/lib/SQL/Abstract.pm
===================================================================
--- SQL-Abstract/1.x/branches/arbitrary_op_nesting/lib/SQL/Abstract.pm	2010-02-04 13:41:59 UTC (rev 8538)
+++ SQL-Abstract/1.x/branches/arbitrary_op_nesting/lib/SQL/Abstract.pm	2010-02-04 14:03:59 UTC (rev 8539)
@@ -109,13 +109,24 @@
 #======================================================================
 
 sub insert {
-  my $self  = shift;
-  my $table = $self->_table(shift);
-  my $data  = shift || return;
+  my $self    = shift;
+  my $table   = $self->_table(shift);
+  my $data    = shift || return;
+  my $options = shift;
 
   my $method       = $self->_METHOD_FOR_refkind("_insert", $data);
-  my ($sql, @bind) = $self->$method($data); 
+  my ($sql, @bind) = $self->$method($data);
   $sql = join " ", $self->_sqlcase('insert into'), $table, $sql;
+
+  if (my $fields = $options->{returning}) {
+    my $f = $self->_SWITCH_refkind($fields, {
+      ARRAYREF     => sub {join ', ', map { $self->_quote($_) } @$fields;},
+      SCALAR       => sub {$self->_quote($fields)},
+      SCALARREF    => sub {$$fields},
+    });
+    $sql .= join " ", $self->_sqlcase(' returning'), $f;
+  }
+
   return wantarray ? ($sql, @bind) : $sql;
 }
 
@@ -1675,7 +1686,7 @@
 
 =back
 
-=head2 insert($table, \@values || \%fieldvals)
+=head2 insert($table, \@values || \%fieldvals, \%options)
 
 This is the simplest function. You simply give it a table name
 and either an arrayref of values or hashref of field/value pairs.
@@ -1684,6 +1695,23 @@
 L</"Inserting and Updating SQL"> for information on how to insert
 with those data types.
 
+The optional C<\%options> hash reference may contain additional
+options to generate the insert SQL. Currently supported options
+are:
+
+=over 4
+
+=item returning
+
+Takes either a scalar of raw SQL fields, or an array reference of
+field names, and adds on an SQL C<RETURNING> statement at the end.
+This allows you to return data generated by the insert statement
+(such as row IDs) without performing another C<SELECT> statement.
+Note, however, this is not part of the SQL standard and may not
+be supported by all database engines.
+
+=back
+
 =head2 update($table, \%fieldvals, \%where)
 
 This takes a table, hashref of field/value pairs, and an optional
@@ -2636,6 +2664,7 @@
     Laurent Dami (internal refactoring, multiple -nest, extensible list of special operators, literal SQL)
     Norbert Buchmuller (support for literal SQL in hashpair, misc. fixes & tests)
     Peter Rabbitson (rewrite of SQLA::Test, misc. fixes & tests)
+    Oliver Charles (support for "RETURNING" after "INSERT")
 
 Thanks!
 

Modified: SQL-Abstract/1.x/branches/arbitrary_op_nesting/t/01generate.t
===================================================================
--- SQL-Abstract/1.x/branches/arbitrary_op_nesting/t/01generate.t	2010-02-04 13:41:59 UTC (rev 8538)
+++ SQL-Abstract/1.x/branches/arbitrary_op_nesting/t/01generate.t	2010-02-04 14:03:59 UTC (rev 8539)
@@ -544,6 +544,46 @@
               stmt_q => 'SELECT * FROM `test` WHERE ( `a` = ? OR `b` = ? ) OR ( `a` = ? AND `b` = ? )',
               bind   => [[a => 1], [b => 1], [ a => 2], [ b => 2]],
       },
+      #60
+      {
+              func   => 'insert',
+              args   => ['test', [qw/1 2 3 4 5/], { returning => 'id' }],
+              stmt   => 'INSERT INTO test VALUES (?, ?, ?, ?, ?) RETURNING id',
+              stmt_q => 'INSERT INTO `test` VALUES (?, ?, ?, ?, ?) RETURNING `id`',
+              bind   => [qw/1 2 3 4 5/],
+      },
+      #60
+      {
+              func   => 'insert',
+              args   => ['test', [qw/1 2 3 4 5/], { returning => 'id, foo, bar' }],
+              stmt   => 'INSERT INTO test VALUES (?, ?, ?, ?, ?) RETURNING id, foo, bar',
+              stmt_q => 'INSERT INTO `test` VALUES (?, ?, ?, ?, ?) RETURNING `id, foo, bar`',
+              bind   => [qw/1 2 3 4 5/],
+      },
+      #61
+      {
+              func   => 'insert',
+              args   => ['test', [qw/1 2 3 4 5/], { returning => [qw(id  foo  bar) ] }],
+              stmt   => 'INSERT INTO test VALUES (?, ?, ?, ?, ?) RETURNING id, foo, bar',
+              stmt_q => 'INSERT INTO `test` VALUES (?, ?, ?, ?, ?) RETURNING `id`, `foo`, `bar`',
+              bind   => [qw/1 2 3 4 5/],
+      },
+      #62
+      {
+              func   => 'insert',
+              args   => ['test', [qw/1 2 3 4 5/], { returning => \'id, foo, bar' }],
+              stmt   => 'INSERT INTO test VALUES (?, ?, ?, ?, ?) RETURNING id, foo, bar',
+              stmt_q => 'INSERT INTO `test` VALUES (?, ?, ?, ?, ?) RETURNING id, foo, bar',
+              bind   => [qw/1 2 3 4 5/],
+      },
+      #63
+      {
+              func   => 'insert',
+              args   => ['test', [qw/1 2 3 4 5/], { returning => \'id' }],
+              stmt   => 'INSERT INTO test VALUES (?, ?, ?, ?, ?) RETURNING id',
+              stmt_q => 'INSERT INTO `test` VALUES (?, ?, ?, ?, ?) RETURNING id',
+              bind   => [qw/1 2 3 4 5/],
+      },
 );
 
 

Modified: SQL-Abstract/1.x/branches/arbitrary_op_nesting/t/05in_between.t
===================================================================
--- SQL-Abstract/1.x/branches/arbitrary_op_nesting/t/05in_between.t	2010-02-04 13:41:59 UTC (rev 8538)
+++ SQL-Abstract/1.x/branches/arbitrary_op_nesting/t/05in_between.t	2010-02-04 14:03:59 UTC (rev 8539)
@@ -101,14 +101,14 @@
   {
     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',
   },

Modified: SQL-Abstract/1.x/branches/arbitrary_op_nesting/t/07subqueries.t
===================================================================
--- SQL-Abstract/1.x/branches/arbitrary_op_nesting/t/07subqueries.t	2010-02-04 13:41:59 UTC (rev 8538)
+++ SQL-Abstract/1.x/branches/arbitrary_op_nesting/t/07subqueries.t	2010-02-04 14:03:59 UTC (rev 8539)
@@ -35,7 +35,7 @@
   };
 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],
 };
 

Modified: SQL-Abstract/1.x/branches/arbitrary_op_nesting/t/10test.t
===================================================================
--- SQL-Abstract/1.x/branches/arbitrary_op_nesting/t/10test.t	2010-02-04 13:41:59 UTC (rev 8538)
+++ SQL-Abstract/1.x/branches/arbitrary_op_nesting/t/10test.t	2010-02-04 14:03:59 UTC (rev 8539)
@@ -19,7 +19,7 @@
 
 
 my @sql_tests = (
-      # WHERE condition - equal
+      # WHERE condition - equal      
       {
         equal => 1,
         statements => [
@@ -581,6 +581,38 @@
           q/SELECT * FROM (SELECT * FROM bar WHERE ((b = 1) AND (c = 10))) AS foo WHERE (a = 2)/,
         ]
       },
+      {
+        equal => 0,
+        statements => [
+          'SELECT a,b,c FROM foo',
+          'SELECT a,c,b FROM foo',
+          'SELECT b,a,c FROM foo',
+          'SELECT b,c,a FROM foo',
+          'SELECT c,a,b FROM foo',
+          'SELECT c,b,a FROM foo',
+        ],
+      },
+      {
+        equal => 0,
+        statements => [
+          'SELECT * FROM foo WHERE a IN (1,2,3)',
+          'SELECT * FROM foo WHERE a IN (1,3,2)',
+          'SELECT * FROM foo WHERE a IN (2,1,3)',
+          'SELECT * FROM foo WHERE a IN (2,3,1)',
+          'SELECT * FROM foo WHERE a IN (3,1,2)',
+          'SELECT * FROM foo WHERE a IN (3,2,1)',
+        ]
+      },
+      {
+        equal => 0,
+        statements => [
+          'SELECT count(*) FROM foo',
+          'SELECT count(*) AS bar FROM foo',
+          'SELECT count(*) AS "bar" FROM foo',
+          'SELECT count(a) FROM foo',
+          'SELECT count(1) FROM foo',
+        ]
+      },
 );
 
 my @bind_tests = (




More information about the Bast-commits mailing list