Keep calling _insert_returning for INSERT … RETURNING
[dbsrgits/SQL-Abstract.git] / lib / SQL / Abstract.pm
index 84499ec..3adfc01 100644 (file)
@@ -27,7 +27,7 @@ BEGIN {
 # GLOBALS
 #======================================================================
 
-our $VERSION  = '1.79';
+our $VERSION  = '1.81';
 
 # This would confuse some packagers
 $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
@@ -78,11 +78,6 @@ sub puke (@) {
 sub is_literal_value ($) {
     ref $_[0] eq 'SCALAR'                                     ? [ ${$_[0]} ]
   : ( ref $_[0] eq 'REF' and ref ${$_[0]} eq 'ARRAY' )        ? [ @${ $_[0] } ]
-  : (
-    ref $_[0] eq 'HASH' and keys %{$_[0]} == 1
-      and
-    defined $_[0]->{-ident} and ! length ref $_[0]->{-ident}
-  )                                                           ? [ $_[0]->{-ident} ]
   : undef;
 }
 
@@ -232,7 +227,10 @@ sub insert {
   return wantarray ? ($sql, @bind) : $sql;
 }
 
-sub _insert_returning {
+# Used by DBIx::Class::SQLMaker->insert
+sub _insert_returning { shift->_returning(@_) }
+
+sub _returning {
   my ($self, $options) = @_;
 
   my $f = $options->{returning};
@@ -353,10 +351,11 @@ sub _insert_values {
 
 
 sub update {
-  my $self  = shift;
-  my $table = $self->_table(shift);
-  my $data  = shift || return;
-  my $where = shift;
+  my $self    = shift;
+  my $table   = $self->_table(shift);
+  my $data    = shift || return;
+  my $where   = shift;
+  my $options = shift;
 
   # first build the 'SET' part of the sql statement
   my (@set, @all_bind);
@@ -419,6 +418,12 @@ sub update {
     push @all_bind, @where_bind;
   }
 
+  if ($options->{returning}) {
+    my ($returning_sql, @returning_bind) = $self->_returning ($options);
+    $sql .= $returning_sql;
+    push @all_bind, @returning_bind;
+  }
+
   return wantarray ? ($sql, @all_bind) : $sql;
 }
 
@@ -605,7 +610,7 @@ sub _where_HASHREF {
         $s = "($s)" unless (
           List::Util::first {$op =~ $_->{regex}} @{$self->{unary_ops}}
             or
-          defined($self->{_nested_func_lhs}) && ($self->{_nested_func_lhs} eq $k)
+          ( defined $self->{_nested_func_lhs} and $self->{_nested_func_lhs} eq $k )
         );
         ($s, @b);
       }
@@ -634,6 +639,11 @@ sub _where_HASHREF {
 sub _where_unary_op {
   my ($self, $op, $rhs) = @_;
 
+  # top level special ops are illegal in general
+  # this includes the -ident/-value ops (dual purpose unary and special)
+  puke "Illegal use of top-level '-$op'"
+    if ! defined $self->{_nested_func_lhs} and List::Util::first {$op =~ $_->{regex}} @{$self->{special_ops}};
+
   if (my $op_entry = List::Util::first {$op =~ $_->{regex}} @{$self->{unary_ops}}) {
     my $handler = $op_entry->{handler};
 
@@ -658,8 +668,8 @@ sub _where_unary_op {
 
   my ($sql, @bind) = $self->_SWITCH_refkind ($rhs, {
     SCALAR =>   sub {
-      puke "Illegal use of top-level '$op'"
-        unless $self->{_nested_func_lhs};
+      puke "Illegal use of top-level '-$op'"
+        unless defined $self->{_nested_func_lhs};
 
       return (
         $self->_convert('?'),
@@ -791,7 +801,7 @@ sub _where_op_VALUE {
 
   # special-case NULL
   if (! defined $rhs) {
-    return $lhs
+    return defined $lhs
       ? $self->_convert($self->_quote($lhs)) . ' IS NULL'
       : undef
     ;
@@ -799,7 +809,7 @@ sub _where_op_VALUE {
 
   my @bind =
     $self->_bindtype (
-      ($lhs || $self->{_nested_func_lhs}),
+      ( defined $lhs ? $lhs : $self->{_nested_func_lhs} ),
       $rhs,
     )
   ;
@@ -850,7 +860,10 @@ sub _where_hashpair_HASHREF {
   my ($self, $k, $v, $logic) = @_;
   $logic ||= 'and';
 
-  local $self->{_nested_func_lhs} = $self->{_nested_func_lhs};
+  local $self->{_nested_func_lhs} = defined $self->{_nested_func_lhs}
+    ? $self->{_nested_func_lhs}
+    : $k
+  ;
 
   my ($all_sql, @all_bind);
 
@@ -929,10 +942,6 @@ sub _where_hashpair_HASHREF {
         },
 
         FALLBACK => sub {       # CASE: col => {op/func => $stuff}
-
-          # retain for proper column type bind
-          $self->{_nested_func_lhs} ||= $k;
-
           ($sql, @bind) = $self->_where_unary_op ($op, $val);
 
           $sql = join (' ',
@@ -1128,7 +1137,6 @@ sub _where_field_BETWEEN {
              my ($func, $arg, @rest) = %$val;
              puke ("Only simple { -func => arg } functions accepted as sub-arguments to BETWEEN")
                if (@rest or $func !~ /^ \- (.+)/x);
-             local $self->{_nested_func_lhs} = $k;
              $self->_where_unary_op ($1 => $arg);
            },
            FALLBACK => sub {
@@ -1186,7 +1194,6 @@ sub _where_field_IN {
               my ($func, $arg, @rest) = %$val;
               puke ("Only simple { -func => arg } functions accepted as sub-arguments to IN")
                 if (@rest or $func !~ /^ \- (.+)/x);
-              local $self->{_nested_func_lhs} = $k;
               $self->_where_unary_op ($1 => $arg);
             },
             UNDEF => sub {
@@ -1245,8 +1252,29 @@ sub _where_field_IN {
 # adding them back in the corresponding method
 sub _open_outer_paren {
   my ($self, $sql) = @_;
-  $sql = $1 while $sql =~ /^ \s* \( (.*) \) \s* $/xs;
-  return $sql;
+
+  while ( my ($inner) = $sql =~ /^ \s* \( (.*) \) \s* $/xs ) {
+
+    # there are closing parens inside, need the heavy duty machinery
+    # to reevaluate the extraction starting from $sql (full reevaluation)
+    if ( $inner =~ /\)/ ) {
+      require Text::Balanced;
+
+      my (undef, $remainder) = do {
+        # idiotic design - writes to $@ but *DOES NOT* throw exceptions
+        local $@;
+        Text::Balanced::extract_bracketed( $sql, '()', qr/\s*/ );
+      };
+
+      # the entire expression needs to be a balanced bracketed thing
+      # (after an extract no remainder sans trailing space)
+      last if defined $remainder and $remainder =~ /\S/;
+    }
+
+    $sql = $inner;
+  }
+
+  $sql;
 }
 
 
@@ -1966,7 +1994,7 @@ words in your database's SQL dialect.
 This is the character that will be used to escape L</quote_char>s appearing
 in an identifier before it has been quoted.
 
-The paramter default in case of a single L</quote_char> character is the quote
+The parameter default in case of a single L</quote_char> character is the quote
 character itself.
 
 When opening-closing-style quoting is used (L</quote_char> is an arrayref)
@@ -2052,7 +2080,7 @@ be supported by all database engines.
 
 =back
 
-=head2 update($table, \%fieldvals, \%where)
+=head2 update($table, \%fieldvals, \%where, \%options)
 
 This takes a table, hashref of field/value pairs, and an optional
 hashref L<WHERE clause|/WHERE CLAUSES>. It returns an SQL UPDATE function and a list
@@ -2061,6 +2089,19 @@ See the sections on L</"Inserting and Updating Arrays"> and
 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 update SQL. Currently supported options
+are:
+
+=over 4
+
+=item returning
+
+See the C<returning> option to
+L<insert|/insert($table, \@values || \%fieldvals, \%options)>.
+
+=back
+
 =head2 select($source, $fields, $where, $order)
 
 This returns a SQL SELECT statement and associated list of bind values, as
@@ -2233,8 +2274,6 @@ module:
 
 =item * C<\[ $sql_string, @bind_values ]>
 
-=item * C<< { -ident => $plain_defined_string } >>
-
 =back
 
 On failure returns C<undef>, on sucess returns an B<array> reference
@@ -2607,10 +2646,16 @@ This difference in syntax is unfortunate but must be preserved for
 historical reasons. So be careful : the two examples below would
 seem algebraically equivalent, but they are not
 
-  {col => [-and => {-like => 'foo%'}, {-like => '%bar'}]}
+  { col => [ -and =>
+    { -like => 'foo%' },
+    { -like => '%bar' },
+  ] }
   # yields : WHERE ( ( col LIKE ? AND col LIKE ? ) )
 
-  [-and => {col => {-like => 'foo%'}, {col => {-like => '%bar'}}]]
+  [ -and =>
+    { col => { -like => 'foo%' } },
+    { col => { -like => '%bar' } },
+  ]
   # yields : WHERE ( ( col LIKE ? OR col LIKE ? ) )