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