X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FAbstract.pm;h=035918741fbc1174edbfdb5712deb487642c2413;hb=d4705371922bba7c32f98f62ed10ee7fd2007d51;hp=09d64e6c56766d4bb724ff26d9632d89cdee41ae;hpb=4030915f8210352b34a10d0780557b26aac7c6a6;p=scpubgit%2FQ-Branch.git diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm index 09d64e6..0359187 100644 --- a/lib/SQL/Abstract.pm +++ b/lib/SQL/Abstract.pm @@ -15,7 +15,7 @@ use Scalar::Util qw/blessed/; # GLOBALS #====================================================================== -our $VERSION = '1.51'; +our $VERSION = '1.52'; # This would confuse some packagers #$VERSION = eval $VERSION; # numify for warning-free dev releases @@ -63,7 +63,7 @@ sub new { 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' ?? @@ -422,7 +422,6 @@ sub _where_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) { my $v = $where->{$k}; @@ -463,7 +462,7 @@ sub _where_op_in_hash { HASHREF => sub { if ($op eq 'OR') { - return $self->_where_ARRAYREF([%$v], 'OR'); + return $self->_where_ARRAYREF([ map { $_ => $v->{$_} } (sort keys %$v) ], 'OR'); } else { # NEST | AND return $self->_where_HASHREF($v); @@ -505,9 +504,10 @@ sub _where_hashpair_ARRAYREF { $self->_debug("ARRAY($k) means distribute over elements"); # put apart first element if it is an operator (-and, -or) - my $op = ($v[0] =~ /^ - (?: AND|OR ) $/ix - ? shift @v - : '' + my $op = ( + (defined $v[0] && $v[0] =~ /^ - (?: AND|OR ) $/ix) + ? shift @v + : '' ); my @distributed = map { {$k => $_} } @v; @@ -711,16 +711,39 @@ sub _where_UNDEF { 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) } @@ -814,7 +837,8 @@ sub _order_by_hash { 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; } @@ -2070,19 +2094,29 @@ Some functions take an order by clause. This can either be a scalar (just a 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/],| + ] | + =========================================================== @@ -2286,6 +2320,7 @@ so I have no idea who they are! But the people I do know are: 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) Thanks! @@ -2304,6 +2339,8 @@ While not an official support venue, C makes heavy use of C, and as such list members there are very familiar with how to create queries. +=head1 LICENSE + 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.