# GLOBALS
#======================================================================
-our $VERSION = '1.49_02';
-$VERSION = eval $VERSION; # numify for warning-free dev releases
+our $VERSION = '1.51';
+# This would confuse some packagers
+#$VERSION = eval $VERSION; # numify for warning-free dev releases
our $AUTOLOAD;
delete $opt{case} if $opt{case} && $opt{case} ne 'lower';
# default logic for interpreting arrayrefs
- $opt{logic} = uc $opt{logic} || 'OR';
+ $opt{logic} = $opt{logic} ? uc $opt{logic} : 'OR';
# how to return bind vars
# LDNOTE: changed nwiger code : why this 'delete' ??
my @clauses = @$where;
- # if the array starts with [-and|or => ...], recurse with that logic
- my $first = $clauses[0] || '';
- if ($first =~ /^-(and|or)/i) {
- $logic = $1;
- shift @clauses;
- return $self->_where_ARRAYREF(\@clauses, $logic);
- }
-
- #otherwise..
my (@sql_clauses, @all_bind);
-
# need to use while() so can shift() for pairs
while (my $el = shift @clauses) {
# skip empty elements, otherwise get invalid trailing AND stuff
ARRAYREF => sub {$self->_recurse_where($el) if @$el},
+ ARRAYREFREF => sub { @{${$el}} if @{${$el}}},
+
HASHREF => sub {$self->_recurse_where($el, 'and') if %$el},
# LDNOTE : previous SQLA code for hashrefs was creating a dirty
# side-effect: the first hashref within an array would change
return $self->_join_sql_clauses($logic, \@sql_clauses, \@all_bind);
}
+#======================================================================
+# WHERE: top-level ARRAYREFREF
+#======================================================================
+sub _where_ARRAYREFREF {
+ my ($self, $where) = @_;
+ my ($sql, @bind) = @{${$where}};
+
+ return ($sql, @bind);
+}
#======================================================================
# WHERE: top-level HASHREF
sub _where_op_in_hash {
- my ($self, $op, $v) = @_;
+ my ($self, $op_str, $v) = @_;
+
+ $op_str =~ /^ (AND|OR|NEST) ( \_? \d* ) $/xi
+ or puke "unknown operator: -$op_str";
+
+ my $op = uc($1); # uppercase, remove trailing digits
+ if ($2) {
+ belch 'Use of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0. '
+ . "You probably wanted ...-and => [ $op_str => COND1, $op_str => COND2 ... ]";
+ }
- $op =~ /^(AND|OR|NEST)[_\d]*/i
- or puke "unknown operator: -$op";
- $op = uc($1); # uppercase, remove trailing digits
$self->_debug("OP(-$op) within hashref, recursing...");
$self->_SWITCH_refkind($v, {
ARRAYREF => sub {
- # LDNOTE : should deprecate {-or => [...]} and {-and => [...]}
- # because they are misleading; the only proper way would be
- # -nest => [-or => ...], -nest => [-and ...]
return $self->_where_ARRAYREF($v, $op eq 'NEST' ? '' : $op);
},
HASHREF => sub {
if ($op eq 'OR') {
- belch "-or => {...} should be -nest => [...]";
return $self->_where_ARRAYREF([%$v], 'OR');
}
else { # NEST | AND
$self->_debug("ARRAY($k) means distribute over elements");
# put apart first element if it is an operator (-and, -or)
- my $op = $v[0] =~ /^-/ ? shift @v : undef;
- $self->_debug("OP($op) reinjected into the distributed array") if $op;
-
+ my $op = ($v[0] =~ /^ - (?: AND|OR ) $/ix
+ ? shift @v
+ : ''
+ );
my @distributed = map { {$k => $_} } @v;
- unshift @distributed, $op if $op;
- return $self->_recurse_where(\@distributed);
+ 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 {
# LDNOTE : not sure of this one. What does "distribute over nothing" mean?
}
sub _where_hashpair_HASHREF {
- my ($self, $k, $v) = @_;
+ my ($self, $k, $v, $logic) = @_;
+ $logic ||= 'and';
- my (@all_sql, @all_bind);
+ my ($all_sql, @all_bind);
for my $op (sort keys %$v) {
my $val = $v->{$op};
@bind = @sub_bind;
},
+ HASHREF => sub {
+ ($sql, @bind) = $self->_where_hashpair_HASHREF($k, $val, $op);
+ },
+
UNDEF => sub { # CASE: col => {op => undef} : sql "IS (NOT)? NULL"
my $is = ($op =~ $self->{equality_op}) ? 'is' :
($op =~ $self->{inequality_op}) ? 'is not' :
});
}
- push @all_sql, $sql;
+ ($all_sql) = (defined $all_sql and $all_sql) ? $self->_join_sql_clauses($logic, [$all_sql, $sql], []) : $sql;
push @all_bind, @bind;
}
-
- return $self->_join_sql_clauses('and', \@all_sql, \@all_bind);
+ return ($all_sql, @all_bind);
}
if(@$vals) {
$self->_debug("ARRAY($vals) means multiple elements: [ @$vals ]");
-
-
- # LDNOTE : change the distribution logic when
+ # LDNOTE : had planned to change the distribution logic when
# $op =~ $self->{inequality_op}, because of Morgan laws :
# with {field => {'!=' => [22, 33]}}, it would be ridiculous to generate
# WHERE field != 22 OR field != 33 : the user probably means
# WHERE field != 22 AND field != 33.
- my $logic = ($op =~ $self->{inequality_op}) ? 'AND' : 'OR';
+ # To do this, replace the line below by :
+ # my $logic = ($op =~ $self->{inequality_op}) ? 'AND' : 'OR';
+ # return $self->_recurse_where([map { {$k => {$op, $_}} } @$vals], $logic);
# distribute $op over each member of @$vals
- return $self->_recurse_where([map { {$k => {$op, $_}} } @$vals], $logic);
-
+ return $self->_recurse_where([map { {$k => {$op, $_}} } @$vals]);
}
else {
# try to DWIM on equality operators
sub _where_field_BETWEEN {
my ($self, $k, $op, $vals) = @_;
- ref $vals eq 'ARRAY' && @$vals == 2
- or puke "special op 'between' requires an arrayref of two values";
+ (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 ($label) = $self->_convert($self->_quote($k));
- my ($placeholder) = $self->_convert('?');
- my $and = $self->_sqlcase('and');
+ my ($clause, @bind, $label, $and, $placeholder);
+ $label = $self->_convert($self->_quote($k));
+ $and = ' ' . $self->_sqlcase('and') . ' ';
+ $placeholder = $self->_convert('?');
$op = $self->_sqlcase($op);
- my $sql = "( $label $op $placeholder $and $placeholder )";
- my @bind = $self->_bindtype($k, @$vals);
+ 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;
+ }
+
+ $clause = (join $and, @all_sql);
+ @bind = $self->_bindtype($k, @all_bind);
+ }
+ my $sql = "( $label $op $clause )";
return ($sql, @bind)
}
my ($order) = ($key =~ /^-(desc|asc)/i)
or puke "invalid key in _order_by hash : $key";
- return $self->_quote($val) ." ". $self->_sqlcase($order);
+ $val = ref $val eq 'ARRAY' ? $val : [$val];
+ return join ', ', map { $self->_quote($_) . ' ' . $self->_sqlcase($order) } @$val;
}
my $data = shift || return;
puke "Argument to ", __PACKAGE__, "->values must be a \\%hash"
unless ref $data eq 'HASH';
- return map { $self->_bindtype($_, $data->{$_}) } sort keys %$data;
+
+ my @all_bind;
+ foreach my $k ( sort keys %$data ) {
+ my $v = $data->{$k};
+ $self->_SWITCH_refkind($v, {
+ ARRAYREF => sub {
+ if ($self->{array_datatypes}) { # array datatype
+ push @all_bind, $self->_bindtype($k, $v);
+ }
+ else { # literal SQL with bind
+ my ($sql, @bind) = @$v;
+ $self->_assert_bindval_matches_bindtype(@bind);
+ push @all_bind, @bind;
+ }
+ },
+ ARRAYREFREF => sub { # literal SQL with bind
+ my ($sql, @bind) = @${$v};
+ $self->_assert_bindval_matches_bindtype(@bind);
+ push @all_bind, @bind;
+ },
+ SCALARREF => sub { # literal SQL without bind
+ },
+ SCALAR_or_UNDEF => sub {
+ push @all_bind, $self->_bindtype($k, $v);
+ },
+ });
+ }
+
+ return @all_bind;
}
sub generate {
=item sqltrue, sqlfalse
Expressions for inserting boolean values within SQL statements.
-By default these are C<1=1> and C<1=0>.
+By default these are C<1=1> and C<1=0>. They are used
+by the special operators C<-in> and C<-not_in> for generating
+correct SQL even when the argument is an empty array (see below).
=item logic
This determines the default logical operator for multiple WHERE
-statements in arrays. By default it is "or", meaning that a WHERE
+statements in arrays or hashes. If absent, the default logic is "or"
+for arrays, and "and" for hashes. This means that a WHERE
array of the form:
@where = (
event_date => {'<=', '4/24/03'},
);
-Will generate SQL like this:
+will generate SQL like this:
WHERE event_date >= '2/13/99' OR event_date <= '4/24/03'
WHERE event_date >= '2/13/99' AND event_date <= '4/24/03'
The logic can also be changed locally by inserting
-an extra first element in the array :
+a modifier in front of an arrayref :
- @where = (-and => event_date => {'>=', '2/13/99'},
- event_date => {'<=', '4/24/03'} );
+ @where = (-and => [event_date => {'>=', '2/13/99'},
+ event_date => {'<=', '4/24/03'} ]);
See the L</"WHERE CLAUSES"> section for explanations.
sub called C<bind_fields()> or something and reuse it repeatedly. You still
get a layer of abstraction over manual SQL specification.
+Note that if you set L</bindtype> to C<columns>, the C<\[$sql, @bind]>
+construct (see L</Literal SQL with placeholders and bind values (subqueries)>)
+will expect the bind values in this format.
+
=item quote_char
This is the character that a table or column name will be quoted
$stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
@bind = ('nwiger', 'assigned', 'in-progress', 'pending');
-An empty arrayref will be considered a logical false and
-will generate 0=1.
+A field associated to an empty arrayref will be considered a
+logical false and will generate 0=1.
-=head2 Key-value pairs
+=head2 Specific comparison operators
If you want to specify a different type of operator for your comparison,
you can use a hashref for a given column:
To test against multiple values, just enclose the values in an arrayref:
- status => { '!=', ['assigned', 'in-progress', 'pending'] };
-
-Which would give you:
-
- "WHERE status != ? AND status != ? AND status != ?"
-
-Notice that since the operator was recognized as being a 'negative'
-operator, the arrayref was interpreted with 'AND' logic (because
-of Morgan's laws). By contrast, the reverse
-
status => { '=', ['assigned', 'in-progress', 'pending'] };
-would generate :
+Which would give you:
"WHERE status = ? OR status = ? OR status = ?"
status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
-In addition to C<-and> and C<-or>, there is also a special C<-nest>
-operator which adds an additional set of parens, to create a subquery.
-For example, to get something like this:
-
- $stmt = "WHERE user = ? AND ( workhrs > ? OR geo = ? )";
- @bind = ('nwiger', '20', 'ASIA');
-
-You would do:
-
- my %where = (
- user => 'nwiger',
- -nest => [ workhrs => {'>', 20}, geo => 'ASIA' ],
- );
-
-If you need several nested subexpressions, you can number
-the C<-nest> branches :
-
- my %where = (
- user => 'nwiger',
- -nest1 => ...,
- -nest2 => ...,
- ...
- );
=head2 Special operators : IN, BETWEEN, etc.
The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
the same way.
+If the argument to C<-in> is an empty array, 'sqlfalse' is generated
+(by default : C<1=0>). Similarly, C<< -not_in => [] >> generates
+'sqltrue' (by default : C<1=1>).
+
+
+
Another pair of operators is C<-between> and C<-not_between>,
used with an arrayref of two values:
These are the two builtin "special operators"; but the
list can be expanded : see section L</"SPECIAL OPERATORS"> below.
-=head2 Nested conditions
+=head2 Nested conditions, -and/-or prefixes
So far, we've seen how multiple conditions are joined with a top-level
C<AND>. We can change this by putting the different conditions we want in
OR ( user = ? AND status = ? ) )";
@bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
-This can be combined with the C<-nest> operator to properly group
-SQL statements:
+
+There is also a special C<-nest>
+operator which adds an additional set of parens, to create a subquery.
+For example, to get something like this:
+
+ $stmt = "WHERE user = ? AND ( workhrs > ? OR geo = ? )";
+ @bind = ('nwiger', '20', 'ASIA');
+
+You would do:
+
+ my %where = (
+ user => 'nwiger',
+ -nest => [ workhrs => {'>', 20}, geo => 'ASIA' ],
+ );
+
+
+Finally, clauses in hashrefs or arrayrefs can be
+prefixed with an C<-and> or C<-or> to change the logic
+inside :
my @where = (
-and => [
user => 'nwiger',
-nest => [
- ["-and", workhrs => {'>', 20}, geo => 'ASIA' ],
- ["-and", workhrs => {'<', 50}, geo => 'EURO' ]
+ -and => [workhrs => {'>', 20}, geo => 'ASIA' ],
+ -and => [workhrs => {'<', 50}, geo => 'EURO' ]
],
],
);
( ( workhrs > ? AND geo = ? )
OR ( workhrs < ? AND geo = ? ) ) )
+
+=head2 Algebraic inconsistency, for historical reasons
+
+C<Important note>: when connecting several conditions, the C<-and->|C<-or>
+operator goes C<outside> of the nested structure; whereas when connecting
+several constraints on one column, the C<-and> operator goes
+C<inside> the arrayref. Here is an example combining both features :
+
+ my @where = (
+ -and => [a => 1, b => 2],
+ -or => [c => 3, d => 4],
+ e => [-and => {-like => 'foo%'}, {-like => '%bar'} ]
+ )
+
+yielding
+
+ WHERE ( ( ( a = ? AND b = ? )
+ OR ( c = ? OR d = ? )
+ OR ( e LIKE ? AND e LIKE ? ) ) )
+
+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'}]}
+ # yields : WHERE ( ( col LIKE ? AND col LIKE ? ) )
+
+ [-and => {col => {-like => 'foo%'}, {col => {-like => '%bar'}}]]
+ # yields : WHERE ( ( col LIKE ? OR col LIKE ? ) )
+
+
=head2 Literal SQL
Finally, sometimes only literal SQL will do. If you want to include
$stmt = "WHERE ( date_column = date '2008-09-30' - ?::integer )"
@bind = ('10');
+Note that you must pass the bind values in the same format as they are returned
+by L</where>. That means that if you set L</bindtype> to C<columns>, you must
+provide the bind values in the C<< [ column_meta => value ] >> format, where
+C<column_meta> is an opaque scalar value; most commonly the column name, but
+you can use any scalar value (including references and blessed references),
+L<SQL::Abstract> will simply pass it through intact. So if C<bindtype> is set
+to C<columns> the above example will look like:
+
+ my %where = (
+ date_column => \[q/= date '2008-09-30' - ?::integer/, [ dummy => 10 ]/]
+ )
Literal SQL is especially useful for nesting parenthesized clauses in the
main SQL query. Here is a first example :
{-desc => 'colB'} |
] |
[colA => {-asc => 'colB'}] | ORDER BY colA, colB ASC
+ { -asc => [qw/colA colB] } | ORDER BY colA ASC, colB ASC
+ { -asc => [qw/colA colB] },|
+ -desc => [qw/colC colD] } | ORDER BY colA ASC, colB ASC, colC DESC, colD DESC
==========================================================
=item *
-added -nest1, -nest2 or -nest_1, -nest_2, ...
-
-=item *
-
optional support for L<array datatypes|/"Inserting and Updating Arrays">
=item *
=item *
fixed bug with global logic, which was previously implemented
-through global variables yielding side-effects. Prior versons would
+through global variables yielding side-effects. Prior versions would
interpret C<< [ {cond1, cond2}, [cond3, cond4] ] >>
as C<< "(cond1 AND cond2) OR (cond3 AND cond4)" >>.
Now this is interpreted
as C<< "(cond1 AND cond2) OR (cond3 OR cond4)" >>.
-=item *
-
-C<-and> / C<-or> operators are no longer accepted
-in the middle of an arrayref : they are
-only admitted if in first position.
-
-=item *
-
-changed logic for distributing an op over arrayrefs
=item *