package SQL::Abstract; # see doc at end of file
-# LDNOTE : this code is heavy refactoring from original SQLA.
-# Several design decisions will need discussion during
-# the test / diffusion / acceptance phase; those are marked with flag
-# 'LDNOTE' (note by laurent.dami AT free.fr)
-
use strict;
use warnings;
use Carp ();
$opt{logic} = $opt{logic} ? uc $opt{logic} : 'OR';
# how to return bind vars
- # LDNOTE: changed nwiger code : why this 'delete' ??
- # $opt{bindtype} ||= delete($opt{bind_type}) || 'normal';
$opt{bindtype} ||= 'normal';
# default comparison is "=", but can be overridden
},
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
- # the global logic to 'AND'. So [ {cond1, cond2}, [cond3, cond4] ]
- # was interpreted as "(cond1 AND cond2) OR (cond3 AND cond4)",
- # whereas it should be "(cond1 AND cond2) OR (cond3 OR cond4)".
SCALARREF => sub { ($$el); },
return $self->_recurse_where(\@distributed, $logic);
}
else {
- # LDNOTE : not sure of this one. What does "distribute over nothing" mean?
$self->_debug("empty ARRAY($k) means 0=1");
return ($self->{sqlfalse});
}
# Conversion, if applicable
sub _convert ($) {
#my ($self, $arg) = @_;
-
-# LDNOTE : modified the previous implementation below because
-# it was not consistent : the first "return" is always an array,
-# the second "return" is context-dependent. Anyway, _convert
-# seems always used with just a single argument, so make it a
-# scalar function.
-# return @_ unless $self->{convert};
-# my $conv = $self->_sqlcase($self->{convert});
-# my @ret = map { $conv.'('.$_.')' } @_;
-# return wantarray ? @ret : $ret[0];
if ($_[0]->{convert}) {
return $_[0]->_sqlcase($_[0]->{convert}) .'(' . $_[1] . ')';
}
# And bindtype
sub _bindtype (@) {
#my ($self, $col, @vals) = @_;
-
- #LDNOTE : changed original implementation below because it did not make
- # sense when bindtype eq 'columns' and @vals > 1.
-# return $self->{bindtype} eq 'columns' ? [ $col, @vals ] : @vals;
-
# called often - tighten code
return $_[0]->{bindtype} eq 'columns'
? map {[$_[1], $_]} @_[2 .. $#_]
#!/usr/bin/perl
+ use warnings;
+ use strict;
+
use CGI::FormBuilder;
use SQL::Abstract;
-#!/usr/bin/perl
-
use strict;
use warnings;
use Test::More;
-use SQL::Abstract::Test import => ['is_same_sql_bind'];
-
-#LDNOTE: renamed all "bind" into "where" because that's what they are
+use SQL::Abstract::Test import => ['is_same_sql'];
+use SQL::Abstract;
my @handle_tests = (
#1
{
args => {logic => 'OR'},
-# stmt => 'SELECT * FROM test WHERE ( a = ? OR b = ? )'
-# LDNOTE: modified the line above (changing the test suite!!!) because
-# the test was not consistent with the doc: hashrefs should not be
-# influenced by the current logic, they always mean 'AND'. So
-# { a => 4, b => 0} should ALWAYS mean ( a = ? AND b = ? ).
-#
-# acked by RIBASUSHI
stmt => 'SELECT * FROM test WHERE ( a = ? AND b = ? )'
},
#2
#5
{
args => {cmp => "=", logic => 'or'},
-# LDNOTE idem
-# stmt => 'SELECT * FROM test WHERE ( a = ? OR b = ? )'
-# acked by RIBASUSHI
stmt => 'SELECT * FROM test WHERE ( a = ? AND b = ? )'
},
#6
#7
{
args => {logic => "or", cmp => "like"},
-# LDNOTE idem
-# stmt => 'SELECT * FROM test WHERE ( a LIKE ? OR b LIKE ? )'
-# acked by RIBASUSHI
stmt => 'SELECT * FROM test WHERE ( a LIKE ? AND b LIKE ? )'
},
#8
},
);
-
-use_ok('SQL::Abstract');
-
for (@handle_tests) {
- local $" = ', ';
- #print "creating a handle with args ($_->{args}): ";
- my $sql = SQL::Abstract->new($_->{args});
- my $where = $_->{where} || { a => 4, b => 0};
- my($stmt, @bind) = $sql->select('test', '*', $where);
+ my $sqla = SQL::Abstract->new($_->{args});
+ my($stmt) = $sqla->select(
+ 'test',
+ '*',
+ $_->{where} || { a => 4, b => 0}
+ );
- # LDNOTE: this original test suite from NWIGER did no comparisons
- # on @bind values, just checking if @bind is nonempty.
- # So here we just fake a [1] bind value for the comparison.
- is_same_sql_bind($stmt, [@bind ? 1 : 0], $_->{stmt}, [1]);
+ is_same_sql($stmt, $_->{stmt});
}
done_testing;
-#!/usr/bin/perl
-
use strict;
use warnings;
use Test::More;
},
{
func => 'update',
-# LDNOTE : removed the "-maybe", because we no longer admit unknown ops
-#
-# acked by RIBASUSHI
-# args => ['fhole', {fpoles => 4}, [-maybe => {race => [-and => [qw(black white asian)]]},
args => ['fhole', {fpoles => 4}, [
{ race => [qw/-or black white asian /] },
{ -nest => { firsttime => [-or => {'=','yes'}, undef] } },
},
{
func => 'select',
-# LDNOTE: modified test below because we agreed with MST that literal SQL
-# should not automatically insert a '='; the user has to do it
-#
-# acked by MSTROUT
-# args => ['test', '*', { a => \["to_date(?, 'MM/DD/YY')", '02/02/02']}],
args => ['test', '*', { a => \["= to_date(?, 'MM/DD/YY')", '02/02/02']}],
stmt => q{SELECT * FROM test WHERE ( a = to_date(?, 'MM/DD/YY') )},
stmt_q => q{SELECT * FROM `test` WHERE ( `a` = to_date(?, 'MM/DD/YY') )},
);
for my $t (@tests) {
- local $"=', ';
-
my $new = $t->{new} || {};
- $new->{debug} = $ENV{DEBUG} || 0;
for my $quoted (0, 1) {
-#!/usr/bin/perl
-
use strict;
use warnings;
use Test::More;
use SQL::Abstract;
-# Make sure to test the examples, since having them break is somewhat
-# embarrassing. :-(
-
my $not_stringifiable = bless {}, 'SQLA::NotStringifiable';
my @handle_tests = (
completion_date => { 'between', ['2002-10-01', '2003-02-06'] },
},
order => \'ticket, requestor',
-#LDNOTE: modified parentheses
-#
-# acked by RIBASUSHI
stmt => "WHERE ( ( completion_date BETWEEN ? AND ? ) AND status = ? ) ORDER BY ticket, requestor",
bind => [qw/2002-10-01 2003-02-06 completed/],
},
requestor => { 'like', undef },
},
order => \'requestor, ticket',
-#LDNOTE: modified parentheses
-#
-# acked by RIBASUSHI
stmt => " WHERE ( ( priority BETWEEN ? AND ? ) AND requestor IS NULL ) ORDER BY requestor, ticket",
bind => [qw/1 3/],
},
'>' => 10,
},
},
-# LDNOTE : modified test below, just parentheses differ
-#
-# acked by RIBASUSHI
stmt => " WHERE ( id = ? AND ( num <= ? AND num > ? ) )",
bind => [qw/1 20 10/],
},
{
-# LDNOTE 23.03.09 : modified test below, just parentheses differ
where => { foo => {-not_like => [7,8,9]},
fum => {'like' => [qw/a b/]},
nix => {'between' => [100,200] },
-#!/usr/bin/perl
-
use strict;
use warnings;
use Test::More;
-#!/usr/bin/perl
-
use strict;
use warnings;
use Test::More;
-#!/usr/bin/perl
-
use strict;
use warnings;
use Test::More;
bind => [],
test => '-in with a literal scalarref',
},
+
+ # note that outer parens are opened even though literal was requested below
{
parenthesis_significant => 1,
where => { x => { -in => \['( ( ?,?,lower(y) ) )', 1, 2] } },
- stmt => "WHERE ( x IN ( ?,?,lower(y) ) )", # note that outer parens are opened even though literal was requested (RIBASUSHI)
+ stmt => "WHERE ( x IN ( ?,?,lower(y) ) )",
bind => [1, 2],
test => '-in with a literal arrayrefref',
},
where => {
status => { -in => \"(SELECT status_codes\nFROM states)" },
},
- # failed to open outer parens on a multi-line query in 1.61 (semifor)
stmt => " WHERE ( status IN ( SELECT status_codes FROM states )) ",
bind => [],
test => '-in multi-line subquery test',
bind => [2000],
test => '-in POD test',
},
+
{
where => { x => { -in => [ \['LOWER(?)', 'A' ], \'LOWER(b)', { -lower => 'c' } ] } },
stmt => " WHERE ( x IN ( LOWER(?), LOWER(b), LOWER ? ) )",
-#!/usr/bin/perl
-
use strict;
use warnings;
use Test::More;
-#!/usr/bin/perl
-
use strict;
use warnings;
use Test::More;
-#!/usr/bin/perl
-
use strict;
use warnings;
use Test::More;
-#!/usr/bin/perl
-
use strict;
use warnings;
use Test::More;
-#!/usr/bin/perl
-
use strict;
use warnings;
projects / dbsrgits/SQL-Abstract.git / commitdiff