use Carp;
use strict;
use warnings;
-use List::Util qw/first/;
+use List::Util qw/first/;
+use Scalar::Util qw/blessed/;
#======================================================================
# GLOBALS
#======================================================================
-our $VERSION = '1.49_01';
+our $VERSION = '1.61';
+
+# This would confuse some packagers
+#$VERSION = eval $VERSION; # numify for warning-free dev releases
our $AUTOLOAD;
# special operators (-in, -between). May be extended/overridden by user.
# See section WHERE: BUILTIN SPECIAL OPERATORS below for implementation
my @BUILTIN_SPECIAL_OPS = (
- {regex => qr/^(not )?between$/i, handler => \&_where_field_BETWEEN},
- {regex => qr/^(not )?in$/i, handler => \&_where_field_IN},
+ {regex => qr/^(not )?between$/i, handler => '_where_field_BETWEEN'},
+ {regex => qr/^(not )?in$/i, handler => '_where_field_IN'},
+);
+
+# unaryish operators - key maps to handler
+my @BUILTIN_UNARY_OPS = (
+ # 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' },
);
#======================================================================
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' ??
# default comparison is "=", but can be overridden
$opt{cmp} ||= '=';
+ # generic SQL comparison operators
+ my $anchored_cmp_ops = join ('|', map { '^' . $_ . '$' } (
+ '(?:is \s+)? (?:not \s+)? like',
+ 'is',
+ (map { quotemeta($_) } (qw/ < > != <> = <= >= /) ),
+ ));
+ $opt{cmp_ops} = qr/$anchored_cmp_ops/ix;
+
# try to recognize which are the 'equality' and 'unequality' ops
# (temporary quickfix, should go through a more seasoned API)
- $opt{equality_op} = qr/^(\Q$opt{cmp}\E|is|(is\s+)?like)$/i;
- $opt{inequality_op} = qr/^(!=|<>|(is\s+)?not(\s+like)?)$/i;
+ $opt{equality_op} = qr/^(\Q$opt{cmp}\E|is|(is\s+)?like)$/i;
+ $opt{inequality_op} = qr/^(!=|<>|(is\s+)?not(\s+like)?)$/i;
# SQL booleans
$opt{sqltrue} ||= '1=1';
$opt{special_ops} ||= [];
push @{$opt{special_ops}}, @BUILTIN_SPECIAL_OPS;
+ # unary operators
+ $opt{unary_ops} ||= [];
+ push @{$opt{unary_ops}}, @BUILTIN_UNARY_OPS;
+
return bless \%opt, $class;
}
#======================================================================
sub insert {
- my $self = shift;
- my $table = $self->_table(shift);
- my $data = shift || return;
+ my $self = shift;
+ my $table = $self->_table(shift);
+ my $data = shift || return;
+ my $options = shift;
my $method = $self->_METHOD_FOR_refkind("_insert", $data);
- my ($sql, @bind) = $self->$method($data);
+ my ($sql, @bind) = $self->$method($data);
$sql = join " ", $self->_sqlcase('insert into'), $table, $sql;
+
+ if (my $ret = $options->{returning}) {
+ $sql .= $self->_insert_returning ($ret);
+ }
+
return wantarray ? ($sql, @bind) : $sql;
}
+sub _insert_returning {
+ my ($self, $fields) = @_;
+
+ my $f = $self->_SWITCH_refkind($fields, {
+ ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$fields;},
+ SCALAR => sub {$self->_quote($fields)},
+ SCALARREF => sub {$$fields},
+ });
+ return join (' ', $self->_sqlcase(' returning'), $f);
+}
+
sub _insert_HASHREF { # explicit list of fields and then values
my ($self, $data) = @_;
my @fields = sort keys %$data;
- my ($sql, @bind);
- { # get values (need temporary override of bindtype to avoid an error)
- local $self->{bindtype} = 'normal';
- ($sql, @bind) = $self->_insert_ARRAYREF([@{$data}{@fields}]);
- }
-
- # if necessary, transform values according to 'bindtype'
- if ($self->{bindtype} eq 'columns') {
- for my $i (0 .. $#fields) {
- ($bind[$i]) = $self->_bindtype($fields[$i], $bind[$i]);
- }
- }
+ my ($sql, @bind) = $self->_insert_values($data);
# assemble SQL
$_ = $self->_quote($_) foreach @fields;
$self->{bindtype} ne 'columns'
or belch "can't do 'columns' bindtype when called with arrayref";
+ # fold the list of values into a hash of column name - value pairs
+ # (where the column names are artificially generated, and their
+ # lexicographical ordering keep the ordering of the original list)
+ my $i = "a"; # incremented values will be in lexicographical order
+ my $data_in_hash = { map { ($i++ => $_) } @$data };
+
+ return $self->_insert_values($data_in_hash);
+}
+
+sub _insert_ARRAYREFREF { # literal SQL with bind
+ my ($self, $data) = @_;
+
+ my ($sql, @bind) = @${$data};
+ $self->_assert_bindval_matches_bindtype(@bind);
+
+ return ($sql, @bind);
+}
+
+
+sub _insert_SCALARREF { # literal SQL without bind
+ my ($self, $data) = @_;
+
+ return ($$data);
+}
+
+sub _insert_values {
+ my ($self, $data) = @_;
+
my (@values, @all_bind);
- for my $v (@$data) {
+ foreach my $column (sort keys %$data) {
+ my $v = $data->{$column};
$self->_SWITCH_refkind($v, {
ARRAYREF => sub {
if ($self->{array_datatypes}) { # if array datatype are activated
push @values, '?';
+ push @all_bind, $self->_bindtype($column, $v);
}
else { # else literal SQL with bind
my ($sql, @bind) = @$v;
+ $self->_assert_bindval_matches_bindtype(@bind);
push @values, $sql;
push @all_bind, @bind;
}
ARRAYREFREF => sub { # literal SQL with bind
my ($sql, @bind) = @${$v};
+ $self->_assert_bindval_matches_bindtype(@bind);
push @values, $sql;
push @all_bind, @bind;
},
# THINK : anything useful to do with a HASHREF ?
+ HASHREF => sub { # (nothing, but old SQLA passed it through)
+ #TODO in SQLA >= 2.0 it will die instead
+ belch "HASH ref as bind value in insert is not supported";
+ push @values, '?';
+ push @all_bind, $self->_bindtype($column, $v);
+ },
SCALARREF => sub { # literal SQL without bind
push @values, $$v;
SCALAR_or_UNDEF => sub {
push @values, '?';
- push @all_bind, $v;
+ push @all_bind, $self->_bindtype($column, $v);
},
});
}
-sub _insert_ARRAYREFREF { # literal SQL with bind
- my ($self, $data) = @_;
- return @${$data};
-}
-
-
-sub _insert_SCALARREF { # literal SQL without bind
- my ($self, $data) = @_;
-
- return ($$data);
-}
-
-
#======================================================================
# UPDATE methods
}
else { # literal SQL with bind
my ($sql, @bind) = @$v;
+ $self->_assert_bindval_matches_bindtype(@bind);
push @set, "$label = $sql";
- push @all_bind, $self->_bindtype($k, @bind);
+ push @all_bind, @bind;
}
},
ARRAYREFREF => sub { # literal SQL with bind
my ($sql, @bind) = @${$v};
+ $self->_assert_bindval_matches_bindtype(@bind);
push @set, "$label = $sql";
- push @all_bind, $self->_bindtype($k, @bind);
+ push @all_bind, @bind;
},
SCALARREF => sub { # literal SQL without bind
push @set, "$label = $$v";
# dispatch on appropriate method according to refkind of $where
my $method = $self->_METHOD_FOR_refkind("_where", $where);
- $self->$method($where, $logic);
+
+
+ my ($sql, @bind) = $self->$method($where, $logic);
+
+ # DBIx::Class directly calls _recurse_where in scalar context, so
+ # we must implement it, even if not in the official API
+ return wantarray ? ($sql, @bind) : $sql;
}
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
my ($self, $where) = @_;
my (@sql_clauses, @all_bind);
- # LDNOTE : don't really know why we need to sort keys
- for my $k (sort keys %$where) {
+ for my $k (sort keys %$where) {
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)
- : do {
- my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $v);
- $self->$method($k, $v);
- };
+ # ($k => $v) is either a special unary op or a regular hashpair
+ my ($sql, @bind) = do {
+ if ($k =~ /^-./) {
+ # put the operator in canonical form
+ my $op = $k;
+ $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("Unary OP(-$op) within hashref, recursing...");
+
+ my $op_entry = first {$op =~ $_->{regex}} @{$self->{unary_ops}};
+ if (my $handler = $op_entry->{handler}) {
+ if (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 ... ]";
+ }
+ $self->$handler ($op, $v);
+ }
+ elsif (ref $handler eq 'CODE') {
+ $handler->($self, $op, $v);
+ }
+ else {
+ puke "Illegal handler for operator $k - expecting a method name or a coderef";
+ }
+ }
+ else {
+ $self->debug("Generic unary OP: $k - recursing as function");
+ $self->_where_func_generic ($op, $v);
+ }
+ }
+ else {
+ my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $v);
+ $self->$method($k, $v);
+ }
+ };
push @sql_clauses, $sql;
push @all_bind, @bind;
return $self->_join_sql_clauses('and', \@sql_clauses, \@all_bind);
}
+sub _where_func_generic {
+ my ($self, $op, $rhs) = @_;
-sub _where_op_in_hash {
- my ($self, $op, $v) = @_;
+ my ($sql, @bind) = $self->_SWITCH_refkind ($rhs, {
+ SCALAR => sub {
+ puke "Illegal use of top-level '$op'"
+ unless $self->{_nested_func_lhs};
- $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...");
+ return (
+ $self->_convert('?'),
+ $self->_bindtype($self->{_nested_func_lhs}, $rhs)
+ );
+ },
+ FALLBACK => sub {
+ $self->_recurse_where ($rhs)
+ },
+ });
- $self->_SWITCH_refkind($v, {
+ $sql = sprintf ('%s%s',
+ $self->_sqlcase($op),
+ ($op =~ $self->{cmp_ops}) ? " $sql" : "( $sql )",
+ );
+ return ($sql, @bind);
+}
+
+sub _where_op_ANDOR {
+ my ($self, $op, $v) = @_;
+
+ $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);
+ return $self->_where_ARRAYREF($v, $op);
},
HASHREF => sub {
- if ($op eq 'OR') {
- belch "-or => {...} should be -nest => [...]";
- return $self->_where_ARRAYREF([%$v], 'OR');
- }
- else { # NEST | AND
- return $self->_where_HASHREF($v);
- }
+ return ( $op =~ /^or/i )
+ ? $self->_where_ARRAYREF( [ map { $_ => $v->{$_} } ( sort keys %$v ) ], $op )
+ : $self->_where_HASHREF($v);
},
- SCALARREF => sub { # literal SQL
- $op eq 'NEST'
- or puke "-$op => \\\$scalar not supported, use -nest => ...";
- return ($$v);
+ SCALARREF => sub {
+ puke "-$op => \\\$scalar not supported, use -nest => ...";
+ },
+
+ ARRAYREFREF => sub {
+ puke "-$op => \\[..] not supported, use -nest => ...";
+ },
+
+ SCALAR => sub { # permissively interpreted as SQL
+ puke "-$op => 'scalar' not supported, use -nest => \\'scalar'";
},
- ARRAYREFREF => sub { # literal SQL
- $op eq 'NEST'
- or puke "-$op => \\[..] not supported, use -nest => ...";
- return @{${$v}};
+ UNDEF => sub {
+ puke "-$op => undef not supported";
},
+ });
+}
+
+sub _where_op_NEST {
+ my ($self, $op, $v) = @_;
+
+ $self->_SWITCH_refkind($v, {
SCALAR => sub { # permissively interpreted as SQL
- $op eq 'NEST'
- or puke "-$op => 'scalar' not supported, use -nest => \\'scalar'";
belch "literal SQL should be -nest => \\'scalar' "
. "instead of -nest => 'scalar' ";
return ($v);
UNDEF => sub {
puke "-$op => undef not supported";
},
+
+ FALLBACK => sub {
+ $self->_recurse_where ($v);
+ },
+
});
}
+sub _where_op_BOOL {
+ my ($self, $op, $v) = @_;
+
+ my ( $prefix, $suffix ) = ( $op =~ /\bnot\b/i )
+ ? ( '(NOT ', ')' )
+ : ( '', '' );
+
+ my ($sql, @bind) = do {
+ $self->_SWITCH_refkind($v, {
+ SCALAR => sub { # interpreted as SQL column
+ $self->_convert($self->_quote($v));
+ },
+
+ UNDEF => sub {
+ puke "-$op => undef not supported";
+ },
+
+ FALLBACK => sub {
+ $self->_recurse_where ($v);
+ },
+ });
+ };
+
+ return (
+ join ('', $prefix, $sql, $suffix),
+ @bind,
+ );
+}
+
+
sub _where_hashpair_ARRAYREF {
my ($self, $k, $v) = @_;
$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 = (
+ (defined $v[0] && $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);
+ local $self->{_nested_func_lhs} = $self->{_nested_func_lhs};
+ $self->{_nested_func_lhs} ||= $k;
- for my $op (sort keys %$v) {
- my $val = $v->{$op};
+ my ($all_sql, @all_bind);
+
+ 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);
+ # 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
- my $special_op = first {$op =~ $_->{regex}} @{$self->{special_ops}};
- if ($special_op) {
- ($sql, @bind) = $special_op->{handler}->($self, $k, $op, $val);
+ elsif ( my $special_op = 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, {
- # CASE: col => {op => \@vals}
- elsif (ref $val eq 'ARRAY') {
- ($sql, @bind) = $self->_where_field_op_ARRAYREF($k, $op, $val);
- }
-
- # CASE: col => {op => undef} : sql "IS (NOT)? NULL"
- elsif (! defined($val)) {
- my $is = ($op =~ $self->{equality_op}) ? 'is' :
- ($op =~ $self->{inequality_op}) ? 'is not' :
- puke "unexpected operator '$op' with undef operand";
- $sql = $self->_quote($k) . $self->_sqlcase(" $is null");
- }
+ ARRAYREF => sub { # CASE: col => {op => \@vals}
+ ($sql, @bind) = $self->_where_field_op_ARRAYREF($k, $op, $val);
+ },
- # CASE: col => {op => $scalar}
- else {
- $sql = join ' ', $self->_convert($self->_quote($k)),
- $self->_sqlcase($op),
- $self->_convert('?');
- @bind = $self->_bindtype($k, $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 =~ $self->{equality_op}) ? 'is' :
+ ($op =~ $self->{inequality_op}) ? '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_func_generic ($op, $val);
+ $sql = join ' ', $self->_convert($self->_quote($k)), $sql;
+ },
+ });
}
- 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);
}
sub _where_field_op_ARRAYREF {
my ($self, $k, $op, $vals) = @_;
- if(@$vals) {
- $self->_debug("ARRAY($vals) means multiple elements: [ @$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;
+ }
+ # distribute $op over each remaining member of @vals, append logic if exists
+ return $self->_recurse_where([map { {$k => {$op, $_}} } @vals], $logic);
- # 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';
-
- # distribute $op over each member of @$vals
- return $self->_recurse_where([map { {$k => {$op, $_}} } @$vals], $logic);
+ # To do this, replace the above to roughly :
+ # my $logic = ($op =~ $self->{inequality_op}) ? 'AND' : 'OR';
+ # return $self->_recurse_where([map { {$k => {$op, $_}} } @vals], $logic);
}
else {
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;
- @bind = $self->_bindtype($k, @bind);
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");
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";
-
- my ($label) = $self->_convert($self->_quote($k));
- my ($placeholder) = $self->_convert('?');
- my $and = $self->_sqlcase('and');
+ my ($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);
+ 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";
+ },
+ });
+
+ my $sql = "( $label $op $clause )";
return ($sql, @bind)
}
# backwards compatibility : if scalar, force into an arrayref
$vals = [$vals] if defined $vals && ! ref $vals;
- ref $vals eq 'ARRAY'
- or puke "special op 'in' requires an arrayref";
-
my ($label) = $self->_convert($self->_quote($k));
my ($placeholder) = $self->_convert('?');
- my $and = $self->_sqlcase('and');
$op = $self->_sqlcase($op);
- if (@$vals) { # nonempty list
- my $placeholders = join ", ", (($placeholder) x @$vals);
- my $sql = "$label $op ( $placeholders )";
- my @bind = $self->_bindtype($k, @$vals);
+ my ($sql, @bind) = $self->_SWITCH_refkind($vals, {
+ ARRAYREF => sub { # list of choices
+ if (@$vals) { # nonempty list
+ my $placeholders = join ", ", (($placeholder) x @$vals);
+ my $sql = "$label $op ( $placeholders )";
+ my @bind = $self->_bindtype($k, @$vals);
- return ($sql, @bind);
- }
- else { # empty list : some databases won't understand "IN ()", so DWIM
- my $sql = ($op =~ /\bnot\b/i) ? $self->{sqltrue} : $self->{sqlfalse};
- return ($sql);
- }
-}
+ return ($sql, @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);
+ },
+ FALLBACK => sub {
+ 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* $/xs;
+ return $sql;
+}
#======================================================================
sub _order_by {
my ($self, $arg) = @_;
- # construct list of ordering instructions
- my @order = $self->_SWITCH_refkind($arg, {
+ my (@sql, @bind);
+ for my $c ($self->_order_by_chunks ($arg) ) {
+ $self->_SWITCH_refkind ($c, {
+ SCALAR => sub { push @sql, $c },
+ ARRAYREF => sub { push @sql, shift @$c; push @bind, @$c },
+ });
+ }
+
+ my $sql = @sql
+ ? sprintf ('%s %s',
+ $self->_sqlcase(' order by'),
+ join (', ', @sql)
+ )
+ : ''
+ ;
+
+ return wantarray ? ($sql, @bind) : $sql;
+}
+
+sub _order_by_chunks {
+ my ($self, $arg) = @_;
+
+ return $self->_SWITCH_refkind($arg, {
ARRAYREF => sub {
- map {$self->_SWITCH_refkind($_, {
- SCALAR => sub {$self->_quote($_)},
- SCALARREF => sub {$$_}, # literal SQL, no quoting
- HASHREF => sub {$self->_order_by_hash($_)}
- }) } @$arg;
+ map { $self->_order_by_chunks ($_ ) } @$arg;
},
+ ARRAYREFREF => sub { [ @$$arg ] },
+
SCALAR => sub {$self->_quote($arg)},
+
+ UNDEF => sub {return () },
+
SCALARREF => sub {$$arg}, # literal SQL, no quoting
- HASHREF => sub {$self->_order_by_hash($arg)},
- });
+ HASHREF => sub {
+ # get first pair in hash
+ my ($key, $val) = each %$arg;
- # build SQL
- my $order = join ', ', @order;
- return $order ? $self->_sqlcase(' order by')." $order" : '';
-}
+ return () unless $key;
+
+ if ( (keys %$arg) > 1 or not $key =~ /^-(desc|asc)/i ) {
+ puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
+ }
+ my $direction = $1;
-sub _order_by_hash {
- my ($self, $hash) = @_;
+ my @ret;
+ for my $c ($self->_order_by_chunks ($val)) {
+ my ($sql, @bind);
- # get first pair in hash
- my ($key, $val) = each %$hash;
+ $self->_SWITCH_refkind ($c, {
+ SCALAR => sub {
+ $sql = $c;
+ },
+ ARRAYREF => sub {
+ ($sql, @bind) = @$c;
+ },
+ });
- # check if one pair was found and no other pair in hash
- $key && !(each %$hash)
- or puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
+ $sql = $sql . ' ' . $self->_sqlcase($direction);
- my ($order) = ($key =~ /^-(desc|asc)/i)
- or puke "invalid key in _order_by hash : $key";
+ push @ret, [ $sql, @bind];
+ }
- return $self->_quote($val) ." ". $self->_sqlcase($order);
+ return @ret;
+ },
+ });
}
-
#======================================================================
# DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES)
#======================================================================
return $self->{bindtype} eq 'columns' ? map {[$col, $_]} @vals : @vals;
}
+# Dies if any element of @bind is not in [colname => value] format
+# if bindtype is 'columns'.
+sub _assert_bindval_matches_bindtype {
+ my ($self, @bind) = @_;
+
+ if ($self->{bindtype} eq 'columns') {
+ foreach my $val (@bind) {
+ if (!defined $val || ref($val) ne 'ARRAY' || @$val != 2) {
+ die "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
+ }
+ }
+ }
+}
+
sub _join_sql_clauses {
my ($self, $logic, $clauses_aref, $bind_aref) = @_;
my ($self, $data) = @_;
my $suffix = '';
my $ref;
+ my $n_steps = 0;
- # $suffix = 'REF' x (length of ref chain, i. e. \\[] is REFREFREF)
while (1) {
- $suffix .= 'REF';
- $ref = ref $data;
- last if $ref ne 'REF';
+ # blessed objects are treated like scalars
+ $ref = (blessed $data) ? '' : ref $data;
+ $n_steps += 1 if $ref;
+ last if $ref ne 'REF';
$data = $$data;
}
- return $ref ? $ref.$suffix :
- defined $data ? 'SCALAR' :
- 'UNDEF';
+ my $base = $ref || (defined $data ? 'SCALAR' : 'UNDEF');
+
+ return $base . ('REF' x $n_steps);
}
+
+
sub _try_refkind {
my ($self, $data) = @_;
my @try = ($self->_refkind($data));
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 {
my $r = ref $v;
my $label = $self->_quote($k);
if ($r eq 'ARRAY') {
- # SQL included for values
- my @bind = @$v;
- my $sql = shift @bind;
+ # literal SQL with bind
+ my ($sql, @bind) = @$v;
+ $self->_assert_bindval_matches_bindtype(@bind);
push @sqlq, "$label = $sql";
- push @sqlv, $self->_bindtype($k, @bind);
+ push @sqlv, @bind;
} elsif ($r eq 'SCALAR') {
- # embedded literal SQL
+ # literal SQL without bind
push @sqlq, "$label = $$v";
} else {
push @sqlq, "$label = ?";
# unlike insert(), assume these are ONLY the column names, i.e. for SQL
for my $v (@$_) {
my $r = ref $v;
- if ($r eq 'ARRAY') {
- my @val = @$v;
- push @sqlq, shift @val;
- push @sqlv, @val;
- } elsif ($r eq 'SCALAR') {
+ if ($r eq 'ARRAY') { # literal SQL with bind
+ my ($sql, @bind) = @$v;
+ $self->_assert_bindval_matches_bindtype(@bind);
+ push @sqlq, $sql;
+ push @sqlv, @bind;
+ } elsif ($r eq 'SCALAR') { # literal SQL without bind
# embedded literal SQL
push @sqlq, $$v;
} else {
=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
to extend the syntax understood by L<SQL::Abstract>.
See section L</"SPECIAL OPERATORS"> for details.
+=item unary_ops
+
+Takes a reference to a list of "unary operators"
+to extend the syntax understood by L<SQL::Abstract>.
+See section L</"UNARY OPERATORS"> for details.
+
=back
-=head2 insert($table, \@values || \%fieldvals)
+=head2 insert($table, \@values || \%fieldvals, \%options)
This is the simplest function. You simply give it a table name
and either an arrayref of values or hashref of field/value pairs.
L</"Inserting and Updating SQL"> for information on how to insert
with those data types.
+The optional C<\%options> hash reference may contain additional
+options to generate the insert SQL. Currently supported options
+are:
+
+=over 4
+
+=item returning
+
+Takes either a scalar of raw SQL fields, or an array reference of
+field names, and adds on an SQL C<RETURNING> statement at the end.
+This allows you to return data generated by the insert statement
+(such as row IDs) without performing another C<SELECT> statement.
+Note, however, this is not part of the SQL standard and may not
+be supported by all database engines.
+
+=back
+
=head2 update($table, \%fieldvals, \%where)
This takes a table, hashref of field/value pairs, and an optional
$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 = ?"
$stmt = "WHERE user = ? AND priority = ? OR priority != ?";
@bind = ('nwiger', '2', '1');
+If you want to include literal SQL (with or without bind values), just use a
+scalar reference or array reference as the value:
+
+ my %where = (
+ date_entered => { '>' => \["to_date(?, 'MM/DD/YYYY')", "11/26/2008"] },
+ date_expires => { '<' => \"now()" }
+ );
+
+Which would generate:
+
+ $stmt = "WHERE date_entered > "to_date(?, 'MM/DD/YYYY') AND date_expires < now()";
+ @bind = ('11/26/2008');
+
=head2 Logic and nesting operators
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.
-Another pair of operators is C<-between> and C<-not_between>,
+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>).
+
+In addition to the array you can supply a chunk of literal sql or
+literal sql with bind:
+
+ my %where = {
+ customer => { -in => \[
+ 'SELECT cust_id FROM cust WHERE balance > ?',
+ 2000,
+ ],
+ status => { -in => \'SELECT status_codes FROM states' },
+ };
+
+would generate:
+
+ $stmt = "WHERE (
+ customer IN ( SELECT cust_id FROM cust WHERE balance > ? )
+ AND status IN ( SELECT status_codes FROM states )
+ )";
+ @bind = ('2000');
+
+
+
+Another pair of operators is C<-between> and C<-not_between>,
used with an arrayref of two values:
my %where = (
WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
+Just like with C<-in> all plausible combinations of literal SQL
+are possible:
+
+ my %where = {
+ start0 => { -between => [ 1, 2 ] },
+ start1 => { -between => \["? AND ?", 1, 2] },
+ start2 => { -between => \"lower(x) AND upper(y)" },
+ start3 => { -between => [
+ \"lower(x)",
+ \["upper(?)", 'stuff' ],
+ ] },
+ };
+
+Would give you:
+
+ $stmt = "WHERE (
+ ( start0 BETWEEN ? AND ? )
+ AND ( start1 BETWEEN ? AND ? )
+ AND ( start2 BETWEEN lower(x) AND upper(y) )
+ AND ( start3 BETWEEN lower(x) AND upper(?) )
+ )";
+ @bind = (1, 2, 1, 2, 'stuff');
+
+
These are the two builtin "special operators"; but the
list can be expanded : see section L</"SPECIAL OPERATORS"> below.
-=head2 Nested conditions
+=head2 Unary operators: bool
+
+If you wish to test against boolean columns or functions within your
+database you can use the C<-bool> and C<-not_bool> operators. For
+example to test the column C<is_user> being true and the column
+<is_enabled> being false you would use:-
+
+ my %where = (
+ -bool => 'is_user',
+ -not_bool => 'is_enabled',
+ );
+
+Would give you:
+
+ 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
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
);
-TMTOWTDI.
+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 },
$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 :
column name,) a hash of C<< { -desc => 'col' } >> or C<< { -asc => 'col' } >>,
or an array of either of the two previous forms. Examples:
- Given | Will Generate
+ Given | Will Generate
----------------------------------------------------------
- \'colA DESC' | ORDER BY colA DESC
- 'colA' | ORDER BY colA
- [qw/colA colB/] | ORDER BY colA, colB
- {-asc => 'colA'} | ORDER BY colA ASC
- {-desc => 'colB'} | ORDER BY colB DESC
- [ |
- {-asc => 'colA'}, | ORDER BY colA ASC, colB DESC
- {-desc => 'colB'} |
- ] |
- [colA => {-asc => 'colB'}] | ORDER BY colA, colB ASC
- ==========================================================
+ |
+ \'colA DESC' | ORDER BY colA DESC
+ |
+ 'colA' | ORDER BY colA
+ |
+ [qw/colA colB/] | ORDER BY colA, colB
+ |
+ {-asc => 'colA'} | ORDER BY colA ASC
+ |
+ {-desc => 'colB'} | ORDER BY colB DESC
+ |
+ ['colA', {-asc => 'colB'}] | ORDER BY colA, colB ASC
+ |
+ { -asc => [qw/colA colB] } | ORDER BY colA ASC, colB ASC
+ |
+ [ |
+ { -asc => 'colA' }, | ORDER BY colA ASC, colB DESC,
+ { -desc => [qw/colB/], | colC ASC, colD ASC
+ { -asc => [qw/colC colD/],|
+ ] |
+ ===========================================================
=head1 SPECIAL OPERATORS
my $sqlmaker = SQL::Abstract->new(special_ops => [
- {regex => qr/.../,
+ {
+ regex => qr/.../,
handler => sub {
my ($self, $field, $op, $arg) = @_;
...
- },
+ },
+ },
+ {
+ regex => qr/.../,
+ handler => 'method_name',
},
]);
WHERE MATCH(field) AGAINST (?, ?)
Special operators IN and BETWEEN are fairly standard and therefore
-are builtin within C<SQL::Abstract>. For other operators,
-like the MATCH .. AGAINST example above which is
-specific to MySQL, you can write your own operator handlers :
-supply a C<special_ops> argument to the C<new> method.
-That argument takes an arrayref of operator definitions;
-each operator definition is a hashref with two entries
+are builtin within C<SQL::Abstract> (as the overridable methods
+C<_where_field_IN> and C<_where_field_BETWEEN>). For other operators,
+like the MATCH .. AGAINST example above which is specific to MySQL,
+you can write your own operator handlers - supply a C<special_ops>
+argument to the C<new> method. That argument takes an arrayref of
+operator definitions; each operator definition is a hashref with two
+entries:
=over
=item handler
-coderef that will be called when meeting that operator
-in the input tree. The coderef will be called with
-arguments C<< ($self, $field, $op, $arg) >>, and
-should return a C<< ($sql, @bind) >> structure.
+Either a coderef or a plain scalar method name. In both cases
+the expected return is C<< ($sql, @bind) >>.
+
+When supplied with a method name, it is simply called on the
+L<SQL::Abstract/> object as:
+
+ $self->$method_name ($field, $op, $arg)
+
+ Where:
+
+ $op is the part that matched the handler regex
+ $field is the LHS of the operator
+ $arg is the RHS
+
+When supplied with a coderef, it is called as:
+
+ $coderef->($self, $field, $op, $arg)
+
=back
]);
+=head1 UNARY OPERATORS
+
+ my $sqlmaker = SQL::Abstract->new(unary_ops => [
+ {
+ regex => qr/.../,
+ handler => sub {
+ my ($self, $op, $arg) = @_;
+ ...
+ },
+ },
+ {
+ regex => qr/.../,
+ handler => 'method_name',
+ },
+ ]);
+
+A "unary operator" is a SQL syntactic clause that can be
+applied to a field - the operator goes before the field
+
+You can write your own operator handlers - supply a C<unary_ops>
+argument to the C<new> method. That argument takes an arrayref of
+operator definitions; each operator definition is a hashref with two
+entries:
+
+=over
+
+=item regex
+
+the regular expression to match the operator
+
+=item handler
+
+Either a coderef or a plain scalar method name. In both cases
+the expected return is C<< $sql >>.
+
+When supplied with a method name, it is simply called on the
+L<SQL::Abstract/> object as:
+
+ $self->$method_name ($op, $arg)
+
+ Where:
+
+ $op is the part that matched the handler regex
+ $arg is the RHS or argument of the operator
+
+When supplied with a coderef, it is called as:
+
+ $coderef->($self, $op, $arg)
+
+
+=back
+
+
=head1 PERFORMANCE
Thanks to some benchmarking by Mark Stosberg, it turns out that
=item *
-added -nest1, -nest2 or -nest_1, -nest_2, ...
+support for the { operator => \"..." } construct (to embed literal SQL)
+
+=item *
+
+support for the { operator => \["...", @bind] } construct (to embed literal SQL with bind values)
=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 *
Dan Kubb (support for "quote_char" and "name_sep")
Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by)
Laurent Dami (internal refactoring, multiple -nest, extensible list of special operators, literal SQL)
+ Norbert Buchmuller (support for literal SQL in hashpair, misc. fixes & tests)
+ Peter Rabbitson (rewrite of SQLA::Test, misc. fixes & tests)
+ Oliver Charles (support for "RETURNING" after "INSERT")
Thanks!
C<SQL::Abstract>, and as such list members there are very familiar with
how to create queries.
-This module is free software; you may copy this under the terms of
-the GNU General Public License, or the Artistic License, copies of
-which should have accompanied your Perl kit.
+=head1 LICENSE
+
+This module is free software; you may copy this under the same
+terms as perl itself (either the GNU General Public License or
+the Artistic License)
=cut