# GLOBALS
#======================================================================
-our $VERSION = '1.56';
+our $VERSION = '1.61';
# 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' },
);
#======================================================================
#======================================================================
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 $fields = $options->{returning}) {
+ my $f = $self->_SWITCH_refkind($fields, {
+ ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$fields;},
+ SCALAR => sub {$self->_quote($fields)},
+ SCALARREF => sub {$$fields},
+ });
+ $sql .= join " ", $self->_sqlcase(' returning'), $f;
+ }
+
return wantarray ? ($sql, @bind) : $sql;
}
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;
+}
#======================================================================
=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
(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>,
+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.
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.
+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 },
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!
projects / scpubgit/Q-Branch.git / blobdiff