Commit | Line | Data |
4f30591b |
1 | use strict; |
2 | use warnings; |
3 | use Test::More; |
4 | |
5 | use SQL::Abstract::Test import => ['is_same_sql_bind']; |
6 | |
7 | use SQL::Abstract; |
8 | |
48d9f5f8 |
9 | #### WARNING #### |
10 | # |
11 | # -nest has been undocumented on purpose, but is still supported for the |
12 | # foreseable future. Do not rip out the -nest tests before speaking to |
13 | # someone on the DBIC mailing list or in irc.perl.org#dbix-class |
14 | # |
15 | ################# |
16 | |
17 | |
4f30591b |
18 | my $sql = SQL::Abstract->new; |
19 | |
20 | my (@tests, $sub_stmt, @sub_bind, $where); |
21 | |
22 | #1 |
23 | ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?", |
24 | 100, "foo%"); |
25 | $where = { |
26 | foo => 1234, |
27 | bar => \["IN ($sub_stmt)" => @sub_bind], |
28 | }; |
29 | push @tests, { |
30 | where => $where, |
31 | stmt => " WHERE ( bar IN (SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?) AND foo = ? )", |
32 | bind => [100, "foo%", 1234], |
33 | }; |
34 | |
35 | #2 |
36 | ($sub_stmt, @sub_bind) |
428975b0 |
37 | = $sql->select("t1", "c1", {c2 => {"<" => 100}, |
4f30591b |
38 | c3 => {-like => "foo%"}}); |
39 | $where = { |
40 | foo => 1234, |
41 | bar => \["> ALL ($sub_stmt)" => @sub_bind], |
42 | }; |
43 | push @tests, { |
44 | where => $where, |
b9a4fdae |
45 | stmt => " WHERE ( bar > ALL (SELECT c1 FROM t1 WHERE (( c2 < ? AND c3 LIKE ? )) ) AND foo = ? )", |
4f30591b |
46 | bind => [100, "foo%", 1234], |
47 | }; |
48 | |
49 | #3 |
428975b0 |
50 | ($sub_stmt, @sub_bind) |
4f30591b |
51 | = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"}); |
52 | $where = { |
53 | foo => 1234, |
54 | -nest => \["EXISTS ($sub_stmt)" => @sub_bind], |
55 | }; |
56 | push @tests, { |
57 | where => $where, |
58 | stmt => " WHERE ( EXISTS (SELECT * FROM t1 WHERE ( c1 = ? AND c2 > t0.c0 )) AND foo = ? )", |
59 | bind => [1, 1234], |
60 | }; |
61 | |
62 | #4 |
63 | $where = { |
64 | -nest => \["MATCH (col1, col2) AGAINST (?)" => "apples"], |
65 | }; |
66 | push @tests, { |
67 | where => $where, |
68 | stmt => " WHERE ( MATCH (col1, col2) AGAINST (?) )", |
69 | bind => ["apples"], |
70 | }; |
71 | |
72 | |
73 | #5 |
428975b0 |
74 | ($sub_stmt, @sub_bind) |
4f30591b |
75 | = $sql->where({age => [{"<" => 10}, {">" => 20}]}); |
76 | $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause |
77 | $where = { |
78 | lname => {-like => '%son%'}, |
79 | -nest => \["NOT ( $sub_stmt )" => @sub_bind], |
80 | }; |
81 | push @tests, { |
82 | where => $where, |
83 | stmt => " WHERE ( NOT ( ( ( ( age < ? ) OR ( age > ? ) ) ) ) AND lname LIKE ? )", |
84 | bind => [10, 20, '%son%'], |
85 | }; |
86 | |
87 | #6 |
88 | ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?", |
89 | 100, "foo%"); |
90 | $where = { |
91 | foo => 1234, |
92 | bar => { -in => \[$sub_stmt => @sub_bind] }, |
93 | }; |
94 | push @tests, { |
95 | where => $where, |
96 | stmt => " WHERE ( bar IN (SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?) AND foo = ? )", |
97 | bind => [100, "foo%", 1234], |
98 | }; |
99 | |
4f30591b |
100 | for (@tests) { |
101 | |
102 | my($stmt, @bind) = $sql->where($_->{where}, $_->{order}); |
103 | is_same_sql_bind($stmt, \@bind, $_->{stmt}, $_->{bind}); |
104 | } |
105 | |
10e6c946 |
106 | done_testing; |