use Carp ();
use List::Util ();
use Scalar::Util ();
-
-#======================================================================
-# GLOBALS
-#======================================================================
+use Module::Runtime qw(use_module);
+use Moo;
+use namespace::clean;
- our $VERSION = '1.72';
-
- $VERSION = eval $VERSION;
+ our $VERSION = '1.74';
-
+ # This would confuse some packagers
+ $VERSION = eval $VERSION if $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 \s )? between $/ix, handler => '_where_field_BETWEEN'},
- {regex => qr/^ (?: not \s )? in $/ix, handler => '_where_field_IN'},
- {regex => qr/^ ident $/ix, handler => '_where_op_IDENT'},
- {regex => qr/^ value $/ix, handler => '_where_op_VALUE'},
-);
-
-# 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' },
- { regex => qr/^ ident $/xi, handler => '_where_op_IDENT' },
- { regex => qr/^ value $/ix, handler => '_where_op_VALUE' },
-);
-
-#======================================================================
-# DEBUGGING AND ERROR REPORTING
-#======================================================================
-
-sub _debug {
- return unless $_[0]->{debug}; shift; # a little faster
- my $func = (caller(1))[3];
- warn "[$func] ", @_, "\n";
-}
-
sub belch (@) {
my($func) = (caller(1))[3];
Carp::carp "[$func] Warning: ", @_;
stmt => " WHERE ( (NOT ( c AND (NOT ( (NOT a = ?) AND (NOT b) )) )) ) ",
bind => [ 1 ],
},
+ {
+ where => { foo => { '>=', [] } },
+ stmt => " WHERE 0=1",
+ bind => [ ],
+ },
);
- plan tests => ( @handle_tests * 2 );
-
for my $case (@handle_tests) {
local $Data::Dumper::Terse = 1;
my $sql = SQL::Abstract->new;
($stmt, @bind) = $sql->where($case->{where}, $case->{order});
is_same_sql_bind($stmt, \@bind, $case->{stmt}, $case->{bind})
|| diag "Search term:\n" . Dumper $case->{where};
- });
+ }));
+ if ($e) {
+ fail "Died: $e: Search term:\n" . Dumper $case->{where};
+ }
}
+
-dies_ok {
- my $sql = SQL::Abstract->new;
- $sql->where({ foo => { '>=' => [] }},);
-};
-
+ done_testing;
},
);
--# modN and mod_N were a bad design decision - they go away in SQLA2, warn now
--my @numbered_mods = (
- {
- backcompat => {
++# modN and mod_N were a bad design decision - they went away
++my @invalid_numbered_mods = (
+ {
-and => [a => 10, b => 11],
-and2 => [ c => 20, d => 21 ],
-nest => [ x => 1 ],
},
{
where => [a => 1, -nest => {b => 2, c => 3}, -nest => [d => 4, e => 5]],
- stmt => 'WHERE ( ( a = ? OR ( b = ? AND c = ? ) OR ( d = ? OR e = ? ) ) )',
+ stmt => 'WHERE ( ( a = ? OR ( b = ? AND c = ? ) OR d = ? OR e = ? ) )',
bind => [qw/1 2 3 4 5/],
},
++ {
++ where => { -and => [
++ -and => [a => 10, b => 11],
++ -and => [ c => 20, d => 21 ],
++ -nest => [ x => 1 ],
++ -nest => [ y => 2 ],
++ -or => { m => 7, n => 8 },
++ -or => { m => 17, n => 18 },
++ ] },
++ stmt => 'WHERE ( ( a = ? AND b = ? AND c = ? AND d = ? AND ( x = ? ) AND ( y = ? ) AND ( m = ? OR n = ? ) AND ( m = ? OR n = ? ) ) )',
++ bind => [ 10, 11, 20, 21, 1, 2, 7, 8, 17, 18 ],
++ },
++ {
++ where => [ -and => [
++ -and => [a => 10, b => 11],
++ -and => [ c => 20, d => 21 ],
++ -nest => [ x => 1 ],
++ -nest => [ y => 2 ],
++ -or => { m => 7, n => 8 },
++ -or => { m => 17, n => 18 },
++ ] ],
++ stmt => 'WHERE ( ( ( a = ? AND b = ? AND c = ? AND d = ? AND ( x = ? ) AND ( y = ? ) AND ( m = ? OR n = ? ) AND ( m = ? OR n = ? ) ) ) )',
++ bind => [ 10, 11, 20, 21, 1, 2, 7, 8, 17, 18 ],
++ },
);
- plan tests => @and_or_tests*4 + @numbered_mods + @nest_tests*2;
-
for my $case (@and_or_tests) {
TODO: {
local $TODO = $case->{todo} if $case->{todo};
}
}
--
--
--my $w_str = "\QUse of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0\E";
--for my $case (@numbered_mods) {
-- TODO: {
- local $Data::Dumper::Terse = 1;
-
- my @w;
- local $TODO = $case->{todo} if $case->{todo};
-
- local $Data::Dumper::Terse = 1;
-
- my @w;
- local $SIG{__WARN__} = sub { push @w, @_ };
++for my $case (@invalid_numbered_mods) {
my $sql = SQL::Abstract->new ($case->{args} || {});
- lives_ok (sub {
- my ($old_s, @old_b) = $sql->where($case->{backcompat});
- my ($new_s, @new_b) = $sql->where($case->{correct});
- is_same_sql_bind(
- $old_s, \@old_b,
- $new_s, \@new_b,
- 'Backcompat and the correct(tm) syntax result in identical statements',
- ) || diag "Search terms:\n" . Dumper {
- backcompat => $case->{backcompat},
- correct => $case->{correct},
- };
- });
-
- ok (@w, 'Warnings were emitted about a mod_N construct');
-
- my @non_match;
- for (@w) {
- push @non_match, $_ if ($_ !~ /$w_str/);
- }
-
- is (@non_match, 0, 'All warnings match the deprecation message')
- || diag join "\n", 'Rogue warnings:', @non_match;
- }
+ throws_ok (sub {
+ $sql->where($case);
+ }, qr/\QUse of [and|or|nest]_N modifiers is no longer supported/, 'Exception thrown on bogus syntax');
- }
}
+ done_testing;
my @w;
local $SIG{__WARN__} = sub { push @w, @_ };
my $sql = SQL::Abstract->new ($case->{args} || {});
- lives_ok (sub {
- my ($stmt, @bind) = $sql->where($case->{where});
- is_same_sql_bind(
- $stmt,
- \@bind,
- $case->{stmt},
- $case->{bind},
- )
- || diag "Search term:\n" . Dumper $case->{where};
- });
+ my ($stmt, @bind) = $sql->where($case->{where});
+ is_same_sql_bind(
+ $stmt,
+ \@bind,
+ $case->{stmt},
+ $case->{bind},
+ )
+ || diag "Search term:\n" . Dumper $case->{where};
is (@w, 0, $case->{test} || 'No warnings within in-between tests')
|| diag join "\n", 'Emitted warnings:', @w;
- }, "$case->{test} doesn't die");
+ }), "$case->{test} doesn't die");
+ diag "Error: $e\n Search term:\n".Dumper($case->{where}) if $e;
}
}
+
+ done_testing;
},
{
given => [ { -asc => \['colA'] }, { -desc => \['colB LIKE ?', 'test'] }, { -asc => \['colC LIKE ?', 'tost'] }],
- expects => ' ORDER BY colA, colB LIKE ? DESC, colC LIKE ?',
- expects_quoted => ' ORDER BY colA, colB LIKE ? DESC, colC LIKE ?',
+ expects => ' ORDER BY colA ASC, colB LIKE ? DESC, colC LIKE ? ASC',
+ expects_quoted => ' ORDER BY colA ASC, colB LIKE ? DESC, colC LIKE ? ASC',
bind => [qw/test tost/],
},
+ {
+ given => [ { -ASC => 'colA', -NULLS => 'FIRST' }, { -DESC => 'colB', -NULLS => 'LAST' } ],
+ expects => ' ORDER BY colA NULLS FIRST, colB DESC NULLS LAST',
+ expects_quoted => ' ORDER BY `colA` NULLS FIRST, `colB` DESC NULLS LAST',
+ },
+ {
+ given => [ { -asc => 'colA', -nulls => 'first' }, { -desc => 'colB', -nulls => 'last' } ],
+ expects => ' ORDER BY colA NULLS FIRST, colB DESC NULLS LAST',
+ expects_quoted => ' ORDER BY `colA` NULLS FIRST, `colB` DESC NULLS LAST',
+ },
+ {
+ given => { -asc => [qw/colA colB/], -nulls => 'first' } ,
+ expects => ' ORDER BY colA NULLS FIRST, colB NULLS FIRST',
+ expects_quoted => ' ORDER BY `colA` NULLS FIRST, `colB` NULLS FIRST',
+ },
);
-
- plan tests => (scalar(@cases) * 2) + 4;
-
my $sql = SQL::Abstract->new;
my $sqlq = SQL::Abstract->new({quote_char => '`'});
'Undeterministic order exception',
);
+throws_ok(
+ sub { $sql->_order_by({-wibble => "fleem" }) },
+ qr/invalid key in hash/,
+ 'Invalid order exception',
+);
+
+throws_ok(
+ sub { $sql->_order_by({-nulls => "fleem" }) },
+ qr/invalid value for -nulls/,
+ 'Invalid nulls exception',
+);
++
+ done_testing;
projects / dbsrgits/SQL-Abstract.git / commitdiff