# 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;
}
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 },