burn unneccessary _where_ methods
Matt S Trout [Mon, 17 Sep 2018 01:50:28 +0000 (01:50 +0000)]
lib/SQL/Abstract.pm

index 4b72804..ede6ade 100644 (file)
@@ -1081,422 +1081,6 @@ sub _where_op_LITERAL {
   return @$literal;
 }
 
-sub _where_hashpair_ARRAYREF {
-  my ($self, $k, $v) = @_;
-
-  if (@$v) {
-    my @v = @$v; # need copy because of shift below
-    $self->_debug("ARRAY($k) means distribute over elements");
-
-    # put apart first element if it is an operator (-and, -or)
-    my $op = (
-       (defined $v[0] && $v[0] =~ /^ - (?: AND|OR ) $/ix)
-         ? shift @v
-         : ''
-    );
-    my @distributed = map { {$k =>  $_} } @v;
-
-    if ($op) {
-      $self->_debug("OP($op) reinjected into the distributed array");
-      unshift @distributed, $op;
-    }
-
-    my $logic = $op ? substr($op, 1) : '';
-
-    return $self->_recurse_where(\@distributed, $logic);
-  }
-  else {
-    $self->_debug("empty ARRAY($k) means 0=1");
-    return ($self->{sqlfalse});
-  }
-}
-
-sub _where_hashpair_HASHREF {
-  my ($self, $k, $v, $logic) = @_;
-  $logic ||= 'and';
-
-  local $self->{_nested_func_lhs} = defined $self->{_nested_func_lhs}
-    ? $self->{_nested_func_lhs}
-    : $k
-  ;
-
-  my ($all_sql, @all_bind);
-
-  for my $orig_op (sort keys %$v) {
-    my $val = $v->{$orig_op};
-
-    # put the operator in canonical form
-    my $op = $orig_op;
-
-    # FIXME - we need to phase out dash-less ops
-    $op =~ s/^-//;        # remove possible initial dash
-    $op =~ s/^\s+|\s+$//g;# remove leading/trailing space
-    $op =~ s/\s+/ /g;     # compress whitespace
-
-    $self->_assert_pass_injection_guard($op);
-
-    # fixup is_not
-    $op =~ s/^is_not/IS NOT/i;
-
-    # so that -not_foo works correctly
-    $op =~ s/^not_/NOT /i;
-
-    # another retarded special case: foo => { $op => { -value => undef } }
-    if (ref $val eq 'HASH' and keys %$val == 1 and exists $val->{-value} and ! defined $val->{-value} ) {
-      $val = undef;
-    }
-
-    my ($sql, @bind);
-
-    # CASE: col-value logic modifiers
-    if ($orig_op =~ /^ \- (and|or) $/xi) {
-      ($sql, @bind) = $self->_where_hashpair_HASHREF($k, $val, $1);
-    }
-    # CASE: special operators like -in or -between
-    elsif (my $special_op = List::Util::first { $op =~ $_->{regex} } @{$self->{special_ops}}) {
-      my $handler = $special_op->{handler};
-      if (! $handler) {
-        puke "No handler supplied for special operator $orig_op";
-      }
-      elsif (not ref $handler) {
-        ($sql, @bind) = $self->$handler($k, $op, $val);
-      }
-      elsif (ref $handler eq 'CODE') {
-        ($sql, @bind) = $handler->($self, $k, $op, $val);
-      }
-      else {
-        puke "Illegal handler for special operator $orig_op - expecting a method name or a coderef";
-      }
-    }
-    else {
-      $self->_SWITCH_refkind($val, {
-
-        ARRAYREF => sub {       # CASE: col => {op => \@vals}
-          ($sql, @bind) = $self->_where_field_op_ARRAYREF($k, $op, $val);
-        },
-
-        ARRAYREFREF => sub {    # CASE: col => {op => \[$sql, @bind]} (literal SQL with bind)
-          my ($sub_sql, @sub_bind) = @$$val;
-          $self->_assert_bindval_matches_bindtype(@sub_bind);
-          $sql  = join ' ', $self->_convert($self->_quote($k)),
-                            $self->_sqlcase($op),
-                            $sub_sql;
-          @bind = @sub_bind;
-        },
-
-        UNDEF => sub {          # CASE: col => {op => undef} : sql "IS (NOT)? NULL"
-          my $is =
-            $op =~ /^not$/i               ? 'is not'  # legacy
-          : $op =~ $self->{equality_op}   ? 'is'
-          : $op =~ $self->{like_op}       ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is'
-          : $op =~ $self->{inequality_op} ? 'is not'
-          : $op =~ $self->{not_like_op}   ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is not'
-          : puke "unexpected operator '$orig_op' with undef operand";
-
-          $sql = $self->_quote($k) . $self->_sqlcase(" $is null");
-        },
-
-        FALLBACK => sub {       # CASE: col => {op/func => $stuff}
-          ($sql, @bind) = $self->_where_unary_op($op, $val);
-
-          $sql = join(' ',
-            $self->_convert($self->_quote($k)),
-            $self->{_nested_func_lhs} eq $k ? $sql : "($sql)",  # top level vs nested
-          );
-        },
-      });
-    }
-
-    ($all_sql) = (defined $all_sql and $all_sql) ? $self->_join_sql_clauses($logic, [$all_sql, $sql], []) : $sql;
-    push @all_bind, @bind;
-  }
-  return ($all_sql, @all_bind);
-}
-
-sub _where_field_IS {
-  my ($self, $k, $op, $v) = @_;
-
-  my ($s) = $self->_SWITCH_refkind($v, {
-    UNDEF => sub {
-      join ' ',
-        $self->_convert($self->_quote($k)),
-        map { $self->_sqlcase($_)} ($op, 'null')
-    },
-    FALLBACK => sub {
-      puke "$op can only take undef as argument";
-    },
-  });
-
-  $s;
-}
-
-sub _where_field_op_ARRAYREF {
-  my ($self, $k, $op, $vals) = @_;
-
-  my @vals = @$vals;  #always work on a copy
-
-  if (@vals) {
-    $self->_debug(sprintf '%s means multiple elements: [ %s ]',
-      $vals,
-      join(', ', map { defined $_ ? "'$_'" : 'NULL' } @vals ),
-    );
-
-    # see if the first element is an -and/-or op
-    my $logic;
-    if (defined $vals[0] && $vals[0] =~ /^ - (AND|OR) $/ix) {
-      $logic = uc $1;
-      shift @vals;
-    }
-
-    # a long standing API wart - an attempt to change this behavior during
-    # the 1.50 series failed *spectacularly*. Warn instead and leave the
-    # behavior as is
-    if (
-      @vals > 1
-        and
-      (!$logic or $logic eq 'OR')
-        and
-      ($op =~ $self->{inequality_op} or $op =~ $self->{not_like_op})
-    ) {
-      my $o = uc($op);
-      belch "A multi-element arrayref as an argument to the inequality op '$o' "
-          . 'is technically equivalent to an always-true 1=1 (you probably wanted '
-          . "to say ...{ \$inequality_op => [ -and => \@values ] }... instead)"
-      ;
-    }
-
-    # distribute $op over each remaining member of @vals, append logic if exists
-    return $self->_recurse_where([map { {$k => {$op, $_}} } @vals], $logic);
-
-  }
-  else {
-    # try to DWIM on equality operators
-    return
-      $op =~ $self->{equality_op}   ? $self->{sqlfalse}
-    : $op =~ $self->{like_op}       ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->{sqlfalse}
-    : $op =~ $self->{inequality_op} ? $self->{sqltrue}
-    : $op =~ $self->{not_like_op}   ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->{sqltrue}
-    : puke "operator '$op' applied on an empty array (field '$k')";
-  }
-}
-
-
-sub _where_hashpair_SCALARREF {
-  my ($self, $k, $v) = @_;
-  $self->_debug("SCALAR($k) means literal SQL: $$v");
-  my $sql = $self->_quote($k) . " " . $$v;
-  return ($sql);
-}
-
-# literal SQL with bind
-sub _where_hashpair_ARRAYREFREF {
-  my ($self, $k, $v) = @_;
-  $self->_debug("REF($k) means literal SQL: @${$v}");
-  my ($sql, @bind) = @$$v;
-  $self->_assert_bindval_matches_bindtype(@bind);
-  $sql  = $self->_quote($k) . " " . $sql;
-  return ($sql, @bind );
-}
-
-# literal SQL without bind
-sub _where_hashpair_SCALAR {
-  my ($self, $k, $v) = @_;
-  $self->_debug("NOREF($k) means simple key=val: $k $self->{cmp} $v");
-  return ($self->_where_hashpair_HASHREF($k, { $self->{cmp} => $v }));
-}
-
-
-sub _where_hashpair_UNDEF {
-  my ($self, $k, $v) = @_;
-  $self->_debug("UNDEF($k) means IS NULL");
-  return $self->_where_hashpair_HASHREF($k, { -is => undef });
-}
-
-#======================================================================
-# WHERE: TOP-LEVEL OTHERS (SCALARREF, SCALAR, UNDEF)
-#======================================================================
-
-
-sub _where_SCALARREF {
-  my ($self, $where) = @_;
-
-  # literal sql
-  $self->_debug("SCALAR(*top) means literal SQL: $$where");
-  return ($$where);
-}
-
-
-sub _where_SCALAR {
-  my ($self, $where) = @_;
-
-  # literal sql
-  $self->_debug("NOREF(*top) means literal SQL: $where");
-  return ($where);
-}
-
-
-sub _where_UNDEF {
-  my ($self) = @_;
-  return ();
-}
-
-
-#======================================================================
-# WHERE: BUILTIN SPECIAL OPERATORS (-in, -between)
-#======================================================================
-
-
-sub _where_field_BETWEEN {
-  my ($self, $k, $op, $vals) = @_;
-
-  my ($label, $and, $placeholder);
-  $label       = $self->_convert($self->_quote($k));
-  $and         = ' ' . $self->_sqlcase('and') . ' ';
-  $placeholder = $self->_convert('?');
-  $op               = $self->_sqlcase($op);
-
-  my $invalid_args = "Operator '$op' requires either an arrayref with two defined values or expressions, or a single literal scalarref/arrayref-ref";
-
-  my ($clause, @bind) = $self->_SWITCH_refkind($vals, {
-    ARRAYREFREF => sub {
-      my ($s, @b) = @$$vals;
-      $self->_assert_bindval_matches_bindtype(@b);
-      ($s, @b);
-    },
-    SCALARREF => sub {
-      return $$vals;
-    },
-    ARRAYREF => sub {
-      puke $invalid_args if @$vals != 2;
-
-      my (@all_sql, @all_bind);
-      foreach my $val (@$vals) {
-        my ($sql, @bind) = $self->_SWITCH_refkind($val, {
-           SCALAR => sub {
-             return ($placeholder, $self->_bindtype($k, $val) );
-           },
-           SCALARREF => sub {
-             return $$val;
-           },
-           ARRAYREFREF => sub {
-             my ($sql, @bind) = @$$val;
-             $self->_assert_bindval_matches_bindtype(@bind);
-             return ($sql, @bind);
-           },
-           HASHREF => sub {
-             my ($func, $arg, @rest) = %$val;
-             puke "Only simple { -func => arg } functions accepted as sub-arguments to BETWEEN"
-               if (@rest or $func !~ /^ \- (.+)/x);
-             $self->_where_unary_op($1 => $arg);
-           },
-           FALLBACK => sub {
-             puke $invalid_args,
-           },
-        });
-        push @all_sql, $sql;
-        push @all_bind, @bind;
-      }
-
-      return (
-        (join $and, @all_sql),
-        @all_bind
-      );
-    },
-    FALLBACK => sub {
-      puke $invalid_args,
-    },
-  });
-
-  my $sql = "( $label $op $clause )";
-  return ($sql, @bind)
-}
-
-
-sub _where_field_IN {
-  my ($self, $k, $op, $vals) = @_;
-
-  # backwards compatibility: if scalar, force into an arrayref
-  $vals = [$vals] if defined $vals && ! ref $vals;
-
-  my ($label)       = $self->_convert($self->_quote($k));
-  my ($placeholder) = $self->_convert('?');
-  $op               = $self->_sqlcase($op);
-
-  my ($sql, @bind) = $self->_SWITCH_refkind($vals, {
-    ARRAYREF => sub {     # list of choices
-      if (@$vals) { # nonempty list
-        my (@all_sql, @all_bind);
-
-        for my $val (@$vals) {
-          my ($sql, @bind) = $self->_SWITCH_refkind($val, {
-            SCALAR => sub {
-              return ($placeholder, $val);
-            },
-            SCALARREF => sub {
-              return $$val;
-            },
-            ARRAYREFREF => sub {
-              my ($sql, @bind) = @$$val;
-              $self->_assert_bindval_matches_bindtype(@bind);
-              return ($sql, @bind);
-            },
-            HASHREF => sub {
-              my ($func, $arg, @rest) = %$val;
-              puke "Only simple { -func => arg } functions accepted as sub-arguments to IN"
-                if (@rest or $func !~ /^ \- (.+)/x);
-              $self->_where_unary_op($1 => $arg);
-            },
-            UNDEF => sub {
-              puke(
-                'SQL::Abstract before v1.75 used to generate incorrect SQL when the '
-              . "-$op operator was given an undef-containing list: !!!AUDIT YOUR CODE "
-              . 'AND DATA!!! (the upcoming Data::Query-based version of SQL::Abstract '
-              . 'will emit the logically correct SQL instead of raising this exception)'
-              );
-            },
-          });
-          push @all_sql, $sql;
-          push @all_bind, @bind;
-        }
-
-        return (
-          sprintf('%s %s ( %s )',
-            $label,
-            $op,
-            join(', ', @all_sql)
-          ),
-          $self->_bindtype($k, @all_bind),
-        );
-      }
-      else { # empty list: some databases won't understand "IN ()", so DWIM
-        my $sql = ($op =~ /\bnot\b/i) ? $self->{sqltrue} : $self->{sqlfalse};
-        return ($sql);
-      }
-    },
-
-    SCALARREF => sub {  # literal SQL
-      my $sql = $self->_open_outer_paren($$vals);
-      return ("$label $op ( $sql )");
-    },
-    ARRAYREFREF => sub {  # literal SQL with bind
-      my ($sql, @bind) = @$$vals;
-      $self->_assert_bindval_matches_bindtype(@bind);
-      $sql = $self->_open_outer_paren($sql);
-      return ("$label $op ( $sql )", @bind);
-    },
-
-    UNDEF => sub {
-      puke "Argument passed to the '$op' operator can not be undefined";
-    },
-
-    FALLBACK => sub {
-      puke "special op $op requires an arrayref (or scalarref/arrayref-ref)";
-    },
-  });
-
-  return ($sql, @bind);
-}
-
 # Some databases (SQLite) treat col IN (1, 2) different from
 # col IN ( (1, 2) ). Use this to strip all outer parens while
 # adding them back in the corresponding method