# GLOBALS
#======================================================================
-our $VERSION = '1.56';
+our $VERSION = '1.58';
# This would confuse some packagers
#$VERSION = eval $VERSION; # numify for warning-free dev releases
# unaryish operators - key maps to handler
my @BUILTIN_UNARY_OPS = (
- { regex => qr/^and (\s? \d+)?$/xi, handler => '_where_op_ANDOR' },
- { regex => qr/^or (\s? \d+)?$/xi, handler => '_where_op_ANDOR' },
- { regex => qr/^nest (\s? \d+)?$/xi, handler => '_where_op_NEST' },
- { regex => qr/^(not \s?)? bool$/xi, handler => '_where_op_BOOL' },
+ # the digits are backcompat stuff
+ { regex => qr/^and (?: \s? \d+ )? $/xi, handler => '_where_op_ANDOR' },
+ { regex => qr/^or (?: \s? \d+ )? $/xi, handler => '_where_op_ANDOR' },
+ { regex => qr/^nest (?: \s? \d+ )? $/xi, handler => '_where_op_NEST' },
+ { regex => qr/^ (?: not \s )? bool $/xi, handler => '_where_op_BOOL' },
);
#======================================================================
my $v = $where->{$k};
# ($k => $v) is either a special op or a regular hashpair
- my ($sql, @bind) = ($k =~ /^-(.+)/) ? $self->_where_op_in_hash($1, $v)
+ my ($sql, @bind) = ($k =~ /^(-.+)/) ? $self->_where_op_in_hash($1, $v)
: do {
my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $v);
$self->$method($k, $v);
sub _where_op_in_hash {
- my ($self, $op, $v) = @_;
+ my ($self, $orig_op, $v) = @_;
# put the operator in canonical form
- $op =~ s/^-//; # remove initial dash
- $op =~ tr/_/ /; # underscores become spaces
- $op =~ s/^\s+//; # no initial space
- $op =~ s/\s+$//; # no final space
- $op =~ s/\s+/ /; # multiple spaces become one
+ my $op = $orig_op;
+ $op =~ s/^-//; # remove initial dash
+ $op =~ s/[_\t ]+/ /g; # underscores and whitespace become single spaces
+ $op =~ s/^\s+|\s+$//g;# remove leading/trailing space
$self->_debug("OP(-$op) within hashref, recursing...");
my $op_entry = first {$op =~ $_->{regex}} @{$self->{unary_ops}};
my $handler = $op_entry->{handler};
if (! $handler) {
- puke "unknown operator: -$op";
+ puke "unknown operator: $orig_op";
}
elsif (not ref $handler) {
+ if ($op =~ s/\s?\d+$//) {
+ belch 'Use of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0. '
+ . "You probably wanted ...-and => [ -$op => COND1, -$op => COND2 ... ]";
+ }
return $self->$handler ($op, $v);
}
elsif (ref $handler eq 'CODE') {
return $handler->($self, $op, $v);
}
else {
- puke "Illegal handler for operator $op - expecting a method name or a coderef";
+ puke "Illegal handler for operator $orig_op - expecting a method name or a coderef";
}
}
sub _where_op_ANDOR {
my ($self, $op, $v) = @_;
- if ($op =~ s/\s?\d+$//) {
- belch 'Use of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0. '
- . "You probably wanted ...-and => [ $op => COND1, $op => COND2 ... ]";
- }
-
$self->_SWITCH_refkind($v, {
ARRAYREF => sub {
return $self->_where_ARRAYREF($v, $op);
sub _where_op_NEST {
my ($self, $op, $v) = @_;
- if ($op =~ s/\s?\d+$//) {
- belch 'Use of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0. '
- . "You probably wanted ...-and => [ $op => COND1, $op => COND2 ... ]";
- }
-
-
$self->_SWITCH_refkind($v, {
ARRAYREF => sub {
sub _where_op_BOOL {
my ($self, $op, $v) = @_;
- my $prefix = ($op =~ /\bnot\b/i) ? 'NOT ' : '';
+ my ( $prefix, $suffix ) = ( $op =~ /\bnot\b/i )
+ ? ( '(NOT ', ')' )
+ : ( '', '' );
$self->_SWITCH_refkind($v, {
+ ARRAYREF => sub {
+ my ( $sql, @bind ) = $self->_where_ARRAYREF($v, '');
+ return ( ($prefix . $sql . $suffix), @bind );
+ },
+
+ ARRAYREFREF => sub {
+ my ( $sql, @bind ) = @{ ${$v} };
+ return ( ($prefix . $sql . $suffix), @bind );
+ },
+
+ HASHREF => sub {
+ my ( $sql, @bind ) = $self->_where_HASHREF($v);
+ return ( ($prefix . $sql . $suffix), @bind );
+ },
+
SCALARREF => sub { # literal SQL
- return ($prefix . $$v);
+ return ($prefix . $$v . $suffix);
},
SCALAR => sub { # interpreted as SQL column
- return ($prefix . $self->_convert($self->_quote($v)));
+ return ($prefix . $self->_convert($self->_quote($v)) . $suffix);
+ },
+
+ UNDEF => sub {
+ puke "-$op => undef not supported";
},
});
}
my ($all_sql, @all_bind);
- for my $op (sort keys %$v) {
- my $val = $v->{$op};
+ for my $orig_op (sort keys %$v) {
+ my $val = $v->{$orig_op};
# put the operator in canonical form
- $op =~ s/^-//; # remove initial dash
- $op =~ tr/_/ /; # underscores become spaces
- $op =~ s/^\s+//; # no initial space
- $op =~ s/\s+$//; # no final space
- $op =~ s/\s+/ /; # multiple spaces become one
+ my $op = $orig_op;
+ $op =~ s/^-//; # remove initial dash
+ $op =~ s/[_\t ]+/ /g; # underscores and whitespace become single spaces
+ $op =~ s/^\s+|\s+$//g;# remove leading/trailing space
my ($sql, @bind);
if ($special_op) {
my $handler = $special_op->{handler};
if (! $handler) {
- puke "No handler supplied for special operator matching $special_op->{regex}";
+ puke "No handler supplied for special operator $orig_op";
}
elsif (not ref $handler) {
($sql, @bind) = $self->$handler ($k, $op, $val);
($sql, @bind) = $handler->($self, $k, $op, $val);
}
else {
- puke "Illegal handler for special operator matching $special_op->{regex} - expecting a method name or a coderef";
+ puke "Illegal handler for special operator $orig_op - expecting a method name or a coderef";
}
}
else {
UNDEF => sub { # CASE: col => {op => undef} : sql "IS (NOT)? NULL"
my $is = ($op =~ $self->{equality_op}) ? 'is' :
($op =~ $self->{inequality_op}) ? 'is not' :
- puke "unexpected operator '$op' with undef operand";
+ puke "unexpected operator '$orig_op' with undef operand";
$sql = $self->_quote($k) . $self->_sqlcase(" $is null");
},
-
+
FALLBACK => sub { # CASE: col => {op => $scalar}
$sql = join ' ', $self->_convert($self->_quote($k)),
$self->_sqlcase($op),
my @vals = @$vals; #always work on a copy
if(@vals) {
- $self->_debug("ARRAY($vals) means multiple elements: [ @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 ($vals[0] =~ /^ - ( AND|OR ) $/ix) {
+ if (defined $vals[0] && $vals[0] =~ /^ - ( AND|OR ) $/ix) {
$logic = uc $1;
shift @vals;
}
sub _where_field_BETWEEN {
my ($self, $k, $op, $vals) = @_;
- (ref $vals eq 'ARRAY' && @$vals == 2) or
- (ref $vals eq 'REF' && (@$$vals == 1 || @$$vals == 2 || @$$vals == 3))
- or puke "special op 'between' requires an arrayref of two values (or a scalarref or arrayrefref for literal SQL)";
-
- my ($clause, @bind, $label, $and, $placeholder);
+ my ($label, $and, $placeholder);
$label = $self->_convert($self->_quote($k));
$and = ' ' . $self->_sqlcase('and') . ' ';
$placeholder = $self->_convert('?');
$op = $self->_sqlcase($op);
- if (ref $vals eq 'REF') {
- ($clause, @bind) = @$$vals;
- }
- else {
- my (@all_sql, @all_bind);
-
- foreach my $val (@$vals) {
- my ($sql, @bind) = $self->_SWITCH_refkind($val, {
- SCALAR => sub {
- return ($placeholder, ($val));
- },
- SCALARREF => sub {
- return ($self->_convert($$val), ());
- },
- });
- push @all_sql, $sql;
- push @all_bind, @bind;
- }
+ my ($clause, @bind) = $self->_SWITCH_refkind($vals, {
+ ARRAYREFREF => sub {
+ return @$$vals;
+ },
+ SCALARREF => sub {
+ return $$vals;
+ },
+ ARRAYREF => sub {
+ puke "special op 'between' accepts an arrayref with exactly two values"
+ if @$vals != 2;
+
+ my (@all_sql, @all_bind);
+ foreach my $val (@$vals) {
+ my ($sql, @bind) = $self->_SWITCH_refkind($val, {
+ SCALAR => sub {
+ return ($placeholder, ($val));
+ },
+ SCALARREF => sub {
+ return ($self->_convert($$val), ());
+ },
+ ARRAYREFREF => sub {
+ my ($sql, @bind) = @$$val;
+ return ($self->_convert($sql), @bind);
+ },
+ });
+ push @all_sql, $sql;
+ push @all_bind, @bind;
+ }
+
+ return (
+ (join $and, @all_sql),
+ $self->_bindtype($k, @all_bind),
+ );
+ },
+ FALLBACK => sub {
+ puke "special op 'between' accepts an arrayref with two values, or a single literal scalarref/arrayref-ref";
+ },
+ });
- $clause = (join $and, @all_sql);
- @bind = $self->_bindtype($k, @all_bind);
- }
my $sql = "( $label $op $clause )";
return ($sql, @bind)
}
}
},
+ 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);
},
FALLBACK => sub {
- puke "special op 'in' requires an arrayref (or arrayref-ref)";
+ puke "special op 'in' 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
+sub _open_outer_paren {
+ my ($self, $sql) = @_;
+ $sql = $1 while $sql =~ /^ \s* \( (.*) \) \s* $/x;
+ return $sql;
+}
#======================================================================
Would give you:
- WHERE is_user AND NOT is_enabledmv
+ WHERE is_user AND NOT is_enabled
+
+If a more complex combination is required, testing more conditions,
+then you should use the and/or operators:-
+
+ my %where = (
+ -and => [
+ -bool => 'one',
+ -bool => 'two',
+ -bool => 'three',
+ -not_bool => 'four',
+ ],
+ );
+
+Would give you:
+ WHERE one AND two AND three AND NOT four
=head2 Nested conditions, -and/-or prefixes
TMTOWTDI.
-Conditions on boolean columns can be expressed in the
-same way, passing a reference to an empty string :
+Conditions on boolean columns can be expressed in the same way, passing
+a reference to an empty string, however using liternal SQL in this way
+is deprecated - the preferred method is to use the boolean operators -
+see L</"Unary operators: bool"> :
my %where = (
priority => { '<', 2 },
projects / dbsrgits/SQL-Abstract.git / blobdiff