From 6c27863351b039e018db6e10df89e8b1ad687350 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jos=C3=A9=20Joaqu=C3=ADn=20Atria?= <jjatria@gmail.com>
Date: Wed, 7 Sep 2022 15:06:27 +0100
Subject: [PATCH] Handle empty arrays in -in and -between in subclasses

Subclasses that override `_where_field_IN` and `_where_field_BETWEEN`
and conditionally re-dispatch to the default handlers in SQL::Abstract
were not correctly handling empty array references passed as arguments
to `-in`, `-between`, and their negated counterparts.

This behaviour was broken in the refactor that lead to 2.000000, and
more specifically in 1.90_03, going from

    $ perl -Ilib -MSQL::Abstract -E '
      say "version " . $SQL::Abstract::VERSION;
      package X {
        use parent "SQL::Abstract";
        use mro "c3";
        sub _where_field_IN { shift->next::method(@_) }
      }
      say X->new->select( table => ["*"], { foo => { -in => [] } } )
    '
    version 1.9002
    SELECT * FROM table WHERE 0=1

to

    $ perl -Ilib -MSQL::Abstract -E '
      say "version " . $SQL::Abstract::VERSION;
      package X {
        use parent "SQL::Abstract";
        use mro "c3";
        sub _where_field_IN { shift->next::method(@_) }
      }
      say X->new->select( table => ["*"], { foo => { -in => [] } } )
    '
    version 1.9003
    SELECT * FROM table WHERE foo IN ( )

and resulting in illegal SQL.

This was breaking behaviour that resulted in downstream issues affecting
at least SQL::Abstract::More
(see https://github.com/damil/SQL-Abstract-More/issues/20).

Likewise, a class overriding `_where_field_BETWEEN` was not triggering
the parameter validation that disallowed empty array references or
undefined values to be used as parameters to `-between` and its
negation:

    $ perl -Ilib -MSQL::Abstract -E '
      say "version " . $SQL::Abstract::VERSION;
      package X {
        use parent "SQL::Abstract";
        use mro "c3";
        sub _where_field_BETWEEN { shift->next::method(@_) }
      }
      say X->new->select( table => ["*"], { foo => { -between => [] } } )
    '
    version 1.9003
    SELECT * FROM table WHERE ( foo BETWEEN AND )

This change ensures that the path taken by subclasses that override
those methods triggers equivalent code paths to those that don't.

Fixes https://rt.cpan.org/Ticket/Display.html?id=142341
---
 lib/SQL/Abstract.pm | 20 +++++++++++------
 t/05in_between.t    | 53 +++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 66 insertions(+), 7 deletions(-)

diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm
index 81503966..b17b8804 100644
--- a/lib/SQL/Abstract.pm
+++ b/lib/SQL/Abstract.pm
@@ -1596,6 +1596,8 @@ sub _render_op_between {
         unless $low->{-literal};
       $low;
     } else {
+      puke "Arguments to between must be defined"
+        unless defined $low && defined $high;
       +($low, { -keyword => 'and' }, $high);
     }
   };
@@ -1609,13 +1611,17 @@ sub _render_op_in {
   my ($lhs, @rhs) = @$args;
 
   return $self->join_query_parts(' ',
-    $lhs,
-    { -keyword => $op },
-    $self->join_query_parts(' ',
-      '(',
-      $self->join_query_parts(', ', @rhs),
-      ')'
-    ),
+    @rhs
+      ? (
+          $lhs,
+          { -keyword => $op },
+          $self->join_query_parts(' ',
+            '(',
+            $self->join_query_parts(', ', @rhs),
+            ')'
+          )
+        )
+      : $self->${\($op =~ /^not/ ? 'sqltrue' : 'sqlfalse')}
   );
 }
 
diff --git a/t/05in_between.t b/t/05in_between.t
index f32c57aa..f56f682a 100644
--- a/t/05in_between.t
+++ b/t/05in_between.t
@@ -419,4 +419,57 @@ for my $case (@in_between_tests) {
   }
 }
 
+package SubClass {
+  use parent 'SQL::Abstract';
+  use mro 'c3';
+}
+
+package SubClass::OverrideIn {
+  our @ISA = 'SubClass';
+  sub _where_field_IN { shift->next::method(@_) }
+}
+
+package SubClass::OverrideBetween {
+  our @ISA = 'SubClass';
+  sub _where_field_BETWEEN { shift->next::method(@_) }
+}
+
+for (
+  {
+    class => 'SubClass::OverrideIn',
+    where => { foo => { -in => [] } },
+    stmt  => 'WHERE 0=1',
+    label => 'Subclass overriding _where_field_IN with empty array ref for -in',
+  },
+  {
+    class => 'SubClass::OverrideIn',
+    where => { foo => { -not_in => [] } },
+    stmt  => 'WHERE 1=1',
+    label => 'Subclass overriding _where_field_IN with empty array ref for -not_in',
+  },
+  {
+    class  => 'SubClass::OverrideBetween',
+    where  => { foo => { -between => [] } },
+    throws => qr/Fatal: Arguments to between must be defined/,
+    label => 'Subclass overriding _where_field_BETWEEN with empty array ref for -between',
+  },
+  {
+    class  => 'SubClass::OverrideBetween',
+    where  => { foo => { -not_between => [] } },
+    throws => qr/Fatal: Arguments to between must be defined/,
+    label => 'Subclass overriding _where_field_BETWEEN with empty array ref for -not_between',
+  },
+) {
+  if (my $e = $_->{throws}) {
+    my $stmt;
+    throws_ok { ($stmt) = $_->{class}->new->select(table => ['*'], $_->{where}) } $e,
+      $_->{label} . ' throws correctly'
+      or diag dumper ({ where => $_->{where}, result => $stmt });
+  } else {
+    $_->{stmt} = 'SELECT * FROM table ' . $_->{stmt};
+    is +SubClass->new->select( table => ['*'], $_->{where}), $_->{stmt}, $_->{label} . ': parent';
+    is +$_->{class}->new->select( table => ['*'], $_->{where}), $_->{stmt}, $_->{label};
+  }
+}
+
 done_testing;