sub _assert_pass_injection_guard {
if ($_[1] =~ $_[0]->{injection_guard}) {
my $class = ref $_[0];
- die "Possible SQL injection attempt '$_[1]'. If this is indeed a part of the
- "
- . "desired SQL use literal SQL ( \'...' or \[ '...' ] ) or supply your own
-"
- . "{injection_guard} attribute to ${class}->new()"
+ die "Possible SQL injection attempt '$_[1]'. If this is indeed a part of "
+ . "the desired SQL use literal SQL ( \'...' or \[ '...' ] ) or supply "
+ . "your own {injection_guard} attribute to ${class}->new()"
}
}
$dq->{by} = $$arg;
} elsif (ref($arg) eq 'SCALAR') {
- # < mst> right, but if it doesn't match that, it goes "ok, right, not sure,
+ # < mst> right, but if it doesn't match that, it goes "ok, right, not sure,
# totally leaving this untouched as a literal"
# < mst> so I -think- it's relatively robust
# < ribasushi> right, it's relatively safe then
# < ribasushi> is this regex centralized?
# < mst> it only exists in _order_by_to_dq in SQL::Abstract::Converter
- # < mst> it only exists because you were kind enough to support new
+ # < mst> it only exists because you were kind enough to support new
# dbihacks crack combined with old literal order_by crack
# < ribasushi> heh :)
# 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
+# influenced by the current logic, they always mean 'AND'. So
# { a => 4, b => 0} should ALWAYS mean ( a = ? AND b = ? ).
#
# acked by RIBASUSHI
{
args => {convert => "upper"},
stmt => 'SELECT * FROM test WHERE ( ( UPPER(hostname) IN ( UPPER(?), UPPER(?), UPPER(?), UPPER(?) ) AND ( ( UPPER(ticket) = UPPER(?) ) OR ( UPPER(ticket) = UPPER(?) ) OR ( UPPER(ticket) = UPPER(?) ) ) ) OR ( UPPER(tack) BETWEEN UPPER(?) AND UPPER(?) ) OR ( ( ( UPPER(a) = UPPER(?) ) OR ( UPPER(a) = UPPER(?) ) OR ( UPPER(a) = UPPER(?) ) ) AND ( ( UPPER(e) != UPPER(?) ) OR ( UPPER(e) != UPPER(?) ) ) AND UPPER(q) NOT IN ( UPPER(?), UPPER(?), UPPER(?), UPPER(?), UPPER(?), UPPER(?), UPPER(?) ) ) )',
- where => [ { ticket => [11, 12, 13],
+ where => [ { ticket => [11, 12, 13],
hostname => { in => ['ntf', 'avd', 'bvd', '123'] } },
{ tack => { between => [qw/tick tock/] } },
- { a => [qw/b c d/],
- e => { '!=', [qw(f g)] },
+ { a => [qw/b c d/],
+ e => { '!=', [qw(f g)] },
q => { 'not in', [14..20] } } ],
},
);
},
{
- where => {
+ where => {
priority => [ {'>', 3}, {'<', 1} ],
requestor => \'is not null',
},
},
{
- where => {
+ where => {
requestor => { '!=', ['-and', undef, ''] },
},
stmt => " WHERE ( requestor IS NOT NULL AND requestor != ? )",
},
{
- where => {
+ where => {
priority => [ {'>', 3}, {'<', 1} ],
- requestor => { '!=', undef },
+ requestor => { '!=', undef },
},
order => [qw/a b c d e f g/],
stmt => " WHERE ( ( ( priority > ? ) OR ( priority < ? ) ) AND requestor IS NOT NULL )"
},
{
- where => {
+ where => {
priority => { 'between', [1, 3] },
- requestor => { 'like', undef },
+ requestor => { 'like', undef },
},
order => \'requestor, ticket',
#LDNOTE: modified parentheses
{
- where => {
- id => 1,
- num => {
- '<=' => 20,
- '>' => 10,
- },
+ where => {
+ id => 1,
+ num => {
+ '<=' => 20,
+ '>' => 10,
+ },
},
# LDNOTE : modified test below, just parentheses differ
#
local $Data::Dumper::Terse = 1;
my $sql = SQL::Abstract->new;
my($stmt, @bind);
- ok(!(my $e = exception {
+ ok(!(my $e = exception {
($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};
{
my $sql = SQL::Abstract->new;
- my $data = {
+ my $data = {
event => 'rapture',
stuff => 'fluff',
time => \ 'now()',
limitation of one modifier type per hahsref)
* When in condition context i.e. where => { -or { a = 1 } }, each modifier
affects only the immediate element following it.
- * When in column multi-condition context i.e.
+ * When in column multi-condition context i.e.
where => { x => { '!=', [-and, [qw/1 2 3/]] } }, a modifier affects the
OUTER ARRAYREF if and only if it is the first element of said ARRAYREF
%{$and_or_args->{or}},
},
- # test modifiers within hashrefs
+ # test modifiers within hashrefs
{
where => { -or => [
[ foo => 1, bar => 2 ],
%{$and_or_args->{or_and}},
},
- # test modifiers within arrayrefs
+ # test modifiers within arrayrefs
{
where => [ -or => [
[ foo => 1, bar => 2 ],
# the -and should affect the OUTER arrayref, while the internal structures remain intact
{
- where => { x => [
- -and => [ 1, 2 ], { -like => 'x%' }
+ where => { x => [
+ -and => [ 1, 2 ], { -like => 'x%' }
]},
stmt => 'WHERE (x = ? OR x = ?) AND x LIKE ?',
bind => [qw/1 2 x%/],
bind => [1 .. 13],
},
- # 1st -and is in column mode, thus flips the entire array, whereas the
+ # 1st -and is in column mode, thus flips the entire array, whereas the
# 2nd one is just a condition modifier
{
where => [
my $where_copy = $dclone->($case->{where})
if $dclone;;
- lives_ok (sub {
+ lives_ok (sub {
my ($stmt, @bind) = $sql->where($case->{where});
is_same_sql_bind(
$stmt,
where => { x => { -in => [ 1, undef ] } },
stmt => " WHERE ( x IN ( ? ) OR x IS NULL )",
bind => [ 1 ],
- test => '-in with undef as an element',
+ test => '-in with undef as an element',
},
{
where => { x => { -in => [ 1, undef, 2, 3, undef ] } },
#2
($sub_stmt, @sub_bind)
- = $sql->select("t1", "c1", {c2 => {"<" => 100},
+ = $sql->select("t1", "c1", {c2 => {"<" => 100},
c3 => {-like => "foo%"}});
$where = {
foo => 1234,
};
#3
-($sub_stmt, @sub_bind)
+($sub_stmt, @sub_bind)
= $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
$where = {
foo => 1234,
#5
-($sub_stmt, @sub_bind)
+($sub_stmt, @sub_bind)
= $sql->where({age => [{"<" => 10}, {">" => 20}]});
$sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
$where = {
my $sqlmaker = SQL::Abstract->new(special_ops => [
# special op for MySql MATCH (field) AGAINST(word1, word2, ...)
- {regex => qr/^match$/i,
+ {regex => qr/^match$/i,
handler => sub {
my ($self, $field, $op, $arg) = @_;
$arg = [$arg] if not ref $arg;
},
# special op for Basis+ NATIVE
- {regex => qr/^native$/i,
+ {regex => qr/^native$/i,
handler => sub {
my ($self, $field, $op, $arg) = @_;
$arg =~ s/'/''/g;
my @tests = (
- #1
+ #1
{ where => {foo => {-match => 'foo'},
bar => {-match => [qw/foo bar/]}},
stmt => " WHERE ( MATCH (bar) AGAINST (?, ?) AND MATCH (foo) AGAINST (?) )",
use SQL::Abstract::Tree;
my $sqlat = SQL::Abstract::Tree->new({
- colormap => {
- select => ['s(', ')s'],
- where => ['w(', ')w'],
- from => ['f(', ')f'],
- join => ['j(', ')f'],
- on => ['o(', ')o'],
- 'group by' => ['gb(',')gb'],
- 'order by' => ['ob(',')ob'],
- },
+ colormap => {
+ select => ['s(', ')s'],
+ where => ['w(', ')w'],
+ from => ['f(', ')f'],
+ join => ['j(', ')f'],
+ on => ['o(', ')o'],
+ 'group by' => ['gb(',')gb'],
+ 'order by' => ['ob(',')ob'],
+ },
});
for ( keys %{$sqlat->colormap}) {
- my ($l, $r) = @{$sqlat->colormap->{$_}};
- is($sqlat->format_keyword($_), "$l$_$r", "$_ 'colored' correctly");
+ my ($l, $r) = @{$sqlat->colormap->{$_}};
+ is($sqlat->format_keyword($_), "$l$_$r", "$_ 'colored' correctly");
}
+use warnings;
+use strict;
+
use Test::More;
eval "use Test::Pod 1.14";
+use warnings;
+use strict;
+
use Test::More;
# TEMPORARY
--- /dev/null
+use warnings;
+use strict;
+
+use Test::More;
+use File::Glob 'bsd_glob';
+use lib 't/lib';
+
+eval "use Test::EOL 1.0 ()";
+plan skip_all => 'Test::EOL 1.0 required' if $@;
+eval "use Test::NoTabs 0.9 ()";
+plan skip_all => 'Test::NoTabs 0.9 required' if $@;
+
+# FIXME - temporary workaround for RT#82032, RT#82033
+# also add all scripts (no extension) and some extra extensions
+# we want to check
+{
+ no warnings 'redefine';
+ my $is_pm = sub {
+ $_[0] !~ /\./ || $_[0] =~ /\.(?:pm|pod|skip|bash|sql|json|proto)$/i || $_[0] =~ /::/;
+ };
+
+ *Test::EOL::_is_perl_module = $is_pm;
+ *Test::NoTabs::_is_perl_module = $is_pm;
+}
+
+my @pl_targets = qw/t lib script examples/;
+Test::EOL::all_perl_files_ok({ trailing_whitespace => 1 }, @pl_targets);
+Test::NoTabs::all_perl_files_ok(@pl_targets);
+
+# check some non-"perl files" in the root separately
+# use .gitignore as a guide of what to skip
+# (or do not test at all if no .gitignore is found)
+if (open(my $gi, '<', '.gitignore')) {
+ my $skipnames;
+ while (my $ln = <$gi>) {
+ next if $ln =~ /^\s*$/;
+ chomp $ln;
+ $skipnames->{$_}++ for bsd_glob($ln);
+ }
+
+ # that we want to check anyway
+ delete $skipnames->{'META.yml'};
+
+ for my $fn (bsd_glob('*')) {
+ next if $skipnames->{$fn};
+ next unless -f $fn;
+ Test::EOL::eol_unix_ok($fn, { trailing_whitespace => 1 });
+ Test::NoTabs::notabs_ok($fn);
+ }
+}
+
+# FIXME - Test::NoTabs and Test::EOL declare 'no_plan' which conflicts with done_testing
+# https://github.com/schwern/test-more/issues/14
+#done_testing;
projects / dbsrgits/SQL-Abstract.git / commitdiff