1#!/usr/bin/perl
2
3BEGIN {
4   die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n"
5      unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH};
6   unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib";
7};
8
9use strict;
10use warnings FATAL => 'all';
11use English qw(-no_match_vars);
12use Test::More;
13use Data::Dumper;
14
15use Quoter;
16use PerconaTest;
17use DSNParser;
18use Sandbox;
19
20my $dp  = new DSNParser(opts=>$dsn_opts);
21my $sb  = new Sandbox(basedir => '/tmp', DSNParser => $dp);
22my $dbh = $sb->get_dbh_for('master');
23
24my $q = new Quoter;
25
26is(
27   $q->quote('a'),
28   '`a`',
29   'Simple quote OK',
30);
31
32is(
33   $q->quote('a','b'),
34   '`a`.`b`',
35   'multi value',
36);
37
38is(
39   $q->quote('`a`'),
40   '```a```',
41   'already quoted',
42);
43
44is(
45   $q->quote('a`b'),
46   '`a``b`',
47   'internal quote',
48);
49
50is(
51   $q->quote('my db', 'my tbl'),
52   '`my db`.`my tbl`',
53   'quotes db with space and tbl with space'
54);
55
56is( $q->quote_val(1), "'1'", 'number' );
57is( $q->quote_val('001'), "'001'", 'number with leading zero' );
58# is( $q->quote_val(qw(1 2 3)), '1, 2, 3', 'three numbers');
59is( $q->quote_val(qw(a)), "'a'", 'letter');
60is( $q->quote_val("a'"), "'a\\''", 'letter with quotes');
61is( $q->quote_val(undef), 'NULL', 'NULL');
62is( $q->quote_val(''), "''", 'Empty string');
63is( $q->quote_val('\\\''), "'\\\\\\\''", 'embedded backslash');
64# is( $q->quote_val(42, 0), "'42'", 'non-numeric number' );
65# is( $q->quote_val(42, 1), "42", 'number is numeric' );
66is( $q->quote_val('123-abc'), "'123-abc'", 'looks numeric but is string');
67is( $q->quote_val('123abc'), "'123abc'", 'looks numeric but is string');
68is( $q->quote_val('0x89504E470'), '0x89504E470', 'hex string');
69is( $q->quote_val('0x89504E470', is_char => 0), '0x89504E470', 'hex string, with is_char => 0');
70is( $q->quote_val('0x89504E470', is_char => 1), "'0x89504E470'", 'hex string, with is_char => 1');
71is( $q->quote_val('0x89504I470'), "'0x89504I470'", 'looks like hex string');
72is( $q->quote_val('eastside0x3'), "'eastside0x3'", 'looks like hex str (issue 1110');
73
74# Splitting DB and tbl apart
75is_deeply(
76   [$q->split_unquote("`db`.`tbl`")],
77   [qw(db tbl)],
78   'splits with a quoted db.tbl',
79);
80
81is_deeply(
82   [$q->split_unquote("db.tbl")],
83   [qw(db tbl)],
84   'splits with a db.tbl',
85);
86
87is_deeply(
88   [$q->split_unquote("tbl")],
89   [undef, 'tbl'],
90   'splits without a db',
91);
92
93is_deeply(
94   [$q->split_unquote("tbl", "db")],
95   [qw(db tbl)],
96   'splits with a db',
97);
98
99is_deeply(
100   [$q->split_unquote("`db`.`tb``l```")],
101   [qw(db tb`l`)],
102   'splits with a quoted db.tbl ad embedded quotes',
103);
104
105#TODO: {
106#   local $::TODO = "Embedded periods not yet supported";
107#   is_deeply(
108#      [$q->split_unquote("`d.b`.`tbl`")],
109#      [qw(d.b tbl)],
110#      'splits with embedded periods: `d.b`.`tbl`',
111#   );
112#}
113
114is( $q->literal_like('foo'), "'foo'", 'LIKE foo');
115is( $q->literal_like('foo_bar'), "'foo\\_bar'", 'LIKE foo_bar');
116is( $q->literal_like('foo%bar'), "'foo\\%bar'", 'LIKE foo%bar');
117is( $q->literal_like('v_b%a c_'), "'v\\_b\\%a c\\_'", 'LIKE v_b%a c_');
118
119is( $q->join_quote('db', 'tbl'), '`db`.`tbl`', 'join_merge(db, tbl)' );
120is( $q->join_quote(undef, 'tbl'), '`tbl`', 'join_merge(undef, tbl)'  );
121is( $q->join_quote('db', 'foo.tbl'), '`foo`.`tbl`', 'join_merge(db, foo.tbl)' );
122is( $q->join_quote('`db`', '`tbl`'), '`db`.`tbl`', 'join_merge(`db`, `tbl`)' );
123is( $q->join_quote(undef, '`tbl`'), '`tbl`', 'join_merge(undef, `tbl`)'  );
124is( $q->join_quote('`db`', '`foo`.`tbl`'), '`foo`.`tbl`', 'join_merge(`db`, `foo`.`tbl`)' );
125
126# ###########################################################################
127# (de)serialize_list
128# ###########################################################################
129
130is(
131   $q->serialize_list( () ),
132   undef,
133   'Serialize empty list returns undef'
134);
135
136binmode(STDOUT, ':utf8')
137   or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
138binmode(STDERR, ':utf8')
139   or die "Can't binmode(STDERR, ':utf8'): $OS_ERROR";
140
141# Prevent "Wide character in print at Test/Builder.pm" warnings.
142binmode Test::More->builder->$_(), ':encoding(UTF-8)'
143   for qw(output failure_output);
144
145my @latin1_serialize_tests = (
146   [ 'a' ],
147   [ 'a', 'b', ],
148   [ 'a,', 'b', ],  # trailing comma
149   [ ',a', 'b', ],  # leading comma
150   [ 'a', ',b' ],
151   [ 0 ],
152   [ 0, 0 ],
153   [ 1, 2 ],
154   [ '' ],  # emptry string
155   [ '', '', '', ],
156   [ undef ],  # NULL
157   [ undef, undef ],
158   [ undef, '' ],
159   [ '\N' ],  # literal \N
160   [ "un caf\x{e9} na\x{ef}ve" ],  # Latin-1
161   [ "\\," ],
162   [ '\\' ],
163   [ q/"abc\\", 'def'/ ],  # Brian's pathalogical case
164);
165
166my @utf8_serialize_tests = (
167   [ "\x{30cb} \x{e8}" ],  # UTF-8
168);
169
170SKIP: {
171   skip 'Cannot connect to sandbox master', scalar @latin1_serialize_tests
172      unless $dbh;
173
174   $dbh->do('CREATE DATABASE IF NOT EXISTS serialize_test');
175   $dbh->do('DROP TABLE IF EXISTS serialize_test.serialize');
176   $dbh->do('CREATE TABLE serialize_test.serialize (id INT, textval TEXT, blobval BLOB)');
177   # Ensure we are using lantin1 as the default for the connection
178   # From the documentation:
179   # This statement sets the three session system variables character_set_client,
180   # character_set_connection, and character_set_results to the given character set.
181   $dbh->do("SET NAMES 'latin1'");
182   warn Data::Dumper::Dumper($dbh);
183
184   my $sth = $dbh->prepare(
185      "INSERT INTO serialize_test.serialize VALUES (?, ?, ?)"
186   );
187
188   for my $test_index ( 0..$#latin1_serialize_tests ) {
189
190      # Flat, friendly name for the test string
191      my $flat_string
192         =  "["
193         . join( "][",
194               map { defined($_) ? $_ : 'undef' }
195               @{$latin1_serialize_tests[$test_index]})
196         . "]";
197      $flat_string =~ s/\n/\\n/g;
198
199      # INSERT the serialized list of values.
200      my $ser = $q->serialize_list( @{$latin1_serialize_tests[$test_index]} );
201      $sth->execute($test_index, $ser, $ser);
202
203      # SELECT back the values and deserialize them.
204      my ($text_string) = $dbh->selectrow_array(
205         "SELECT textval FROM serialize_test.serialize WHERE id=$test_index");
206      my @text_parts = $q->deserialize_list($text_string);
207
208      is_deeply(
209         \@text_parts,
210         $latin1_serialize_tests[$test_index],
211         "Serialize $flat_string"
212      ) or diag(Dumper($text_string, \@text_parts));
213   }
214};
215
216my $utf8_dbh = $sb->get_dbh_for('master');
217$utf8_dbh->{mysql_enable_utf8} = 1;
218$utf8_dbh->do("SET NAMES 'utf8'");
219SKIP: {
220   skip 'Cannot connect to sandbox master', scalar @utf8_serialize_tests
221      unless $utf8_dbh;
222   skip 'DBD::mysql 3.0007 has UTF-8 bug', scalar @utf8_serialize_tests
223      if $DBD::mysql::VERSION le '3.0007';
224
225   $utf8_dbh->do("DROP TABLE serialize_test.serialize");
226   $utf8_dbh->do("CREATE TABLE serialize_test.serialize (id INT, textval TEXT, blobval BLOB) CHARSET='utf8'");
227
228   my $sth = $utf8_dbh->prepare(
229      "INSERT INTO serialize_test.serialize VALUES (?, ?, ?)"
230   );
231
232   for my $test_index ( 0..$#utf8_serialize_tests ) {
233
234      # Flat, friendly name for the test string
235      my $flat_string
236         =  "["
237         . join( "][",
238               map { defined($_) ? $_ : 'undef' }
239               @{$utf8_serialize_tests[$test_index]})
240         . "]";
241      $flat_string =~ s/\n/\\n/g;
242
243      # INSERT the serialized list of values.
244      my $ser = $q->serialize_list( @{$utf8_serialize_tests[$test_index]} );
245      $sth->execute($test_index, $ser, $ser);
246
247      # SELECT back the values and deserialize them.
248      my ($text_string) = $utf8_dbh->selectrow_array(
249         "SELECT textval FROM serialize_test.serialize WHERE id=$test_index");
250      my @text_parts = $q->deserialize_list($text_string);
251
252      is_deeply(
253         \@text_parts,
254         $utf8_serialize_tests[$test_index],
255         "Serialize UTF-8 $flat_string"
256      ) or diag(Dumper($text_string, \@text_parts));
257   }
258
259   $utf8_dbh->disconnect();
260};
261
262# ###########################################################################
263# Done.
264# ###########################################################################
265if ( $dbh ) {
266   $sb->wipe_clean($dbh);
267   $dbh->disconnect();
268}
269ok($sb->ok(), "Sandbox servers") or BAIL_OUT(__FILE__ . " broke the sandbox");
270done_testing;
271