Added test cases for passing arrayref bind values to insert() and update() when the...
[dbsrgits/SQL-Abstract.git] / t / 08special_ops.t
CommitLineData
96449e8e 1#!/usr/bin/perl\r
2\r
3use strict;\r
4use warnings;\r
5use Test::More;\r
6\r
5aad8cf3 7use SQL::Abstract::Test import => ['is_same_sql_bind'];\r
96449e8e 8plan tests => 2;\r
9\r
10use SQL::Abstract;\r
11\r
12my $sqlmaker = SQL::Abstract->new(special_ops => [\r
13\r
14 # special op for MySql MATCH (field) AGAINST(word1, word2, ...)\r
15 {regex => qr/^match$/i, \r
16 handler => sub {\r
17 my ($self, $field, $op, $arg) = @_;\r
18 $arg = [$arg] if not ref $arg;\r
19 my $label = $self->_quote($field);\r
20 my ($placeholder) = $self->_convert('?');\r
21 my $placeholders = join ", ", (($placeholder) x @$arg);\r
22 my $sql = $self->_sqlcase('match') . " ($label) "\r
23 . $self->_sqlcase('against') . " ($placeholders) ";\r
24 my @bind = $self->_bindtype($field, @$arg);\r
25 return ($sql, @bind);\r
26 }\r
27 },\r
28\r
29 # special op for Basis+ NATIVE\r
30 {regex => qr/^native$/i, \r
31 handler => sub {\r
32 my ($self, $field, $op, $arg) = @_;\r
33 $arg =~ s/'/''/g;\r
34 my $sql = "NATIVE (' $field $arg ')";\r
35 return ($sql);\r
36 }\r
37 },\r
38\r
39]);\r
40\r
41my @tests = (\r
42\r
43 #1 \r
44 { where => {foo => {-match => 'foo'},\r
45 bar => {-match => [qw/foo bar/]}},\r
46 stmt => " WHERE ( MATCH (bar) AGAINST (?, ?) AND MATCH (foo) AGAINST (?) )",\r
47 bind => [qw/foo bar foo/],\r
48 },\r
49\r
50 #2\r
51 { where => {foo => {-native => "PH IS 'bar'"}},\r
52 stmt => " WHERE ( NATIVE (' foo PH IS ''bar'' ') )",\r
53 bind => [],\r
54 },\r
55\r
56);\r
57\r
58\r
59for (@tests) {\r
60\r
61 my($stmt, @bind) = $sqlmaker->where($_->{where}, $_->{order});\r
62 is_same_sql_bind($stmt, \@bind, $_->{stmt}, $_->{bind});\r
63}\r
64\r
65\r
66\r
67\r
68\r