← Back to branch summary

~percona-toolkit-dev/percona-toolkit/2.2

« back to all changes in this revision

Viewing changes to t/lib/Quoter.t

Merge p:~percona-toolkit-dev/percona-toolkit/fix-1087319-quoter-multiple-nulls

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/lib/Quoter.t
10
10
use warnings FATAL => 'all';
11
11
use English qw(-no_match_vars);
12
12
use Test::More;
 
13
use Data::Dumper;
13
14
 
14
15
use Quoter;
15
16
use PerconaTest;
 
17
use DSNParser;
 
18
use Sandbox;
 
19
my $dp  = new DSNParser(opts=>$dsn_opts);
 
20
my $sb  = new Sandbox(basedir => '/tmp', DSNParser => $dp);
 
21
my $dbh = $sb->get_dbh_for('master');
16
22
 
17
23
my $q = new Quoter;
18
24
 
95
101
   'splits with a quoted db.tbl ad embedded quotes',
96
102
);
97
103
 
98
 
TODO: {
99
 
   local $::TODO = "Embedded periods not yet supported";
100
 
   is_deeply(
101
 
      [$q->split_unquote("`d.b`.`tbl`")],
102
 
      [qw(d.b tbl)],
103
 
      'splits with embedded periods: `d.b`.`tbl`',
104
 
   );
105
 
}
 
104
#TODO: {
 
105
#   local $::TODO = "Embedded periods not yet supported";
 
106
#   is_deeply(
 
107
#      [$q->split_unquote("`d.b`.`tbl`")],
 
108
#      [qw(d.b tbl)],
 
109
#      'splits with embedded periods: `d.b`.`tbl`',
 
110
#   );
 
111
#}
106
112
 
107
113
is( $q->literal_like('foo'), "'foo'", 'LIKE foo');
108
114
is( $q->literal_like('foo_bar'), "'foo\\_bar'", 'LIKE foo_bar');
121
127
# ###########################################################################
122
128
 
123
129
is(
124
 
   $q->serialize_list(),
125
 
   undef,
126
 
   "Serialize empty list"
127
 
);
128
 
 
129
 
is(
130
 
   $q->serialize_list(''),
131
 
   '',
132
 
   "Serialize 1 empty string",
133
 
);
134
 
 
135
 
is(
136
 
   $q->serialize_list('', '', ''),
137
 
   ',,',
138
 
   "Serialize 3 empty strings",
139
 
);
140
 
 
141
 
is(
142
 
   $q->serialize_list(undef),
143
 
   undef,
144
 
   "Serialize undef string",
145
 
);
146
 
 
147
 
is(
148
 
   $q->deserialize_list(undef),
149
 
   undef,
150
 
   "Deserialize undef string",
151
 
);
152
 
 
153
 
my @serialize_tests = (
 
130
   $q->serialize_list( () ),
 
131
   undef,
 
132
   'Serialize empty list returns undef'
 
133
);
 
134
   
 
135
binmode(STDOUT, ':utf8')
 
136
   or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
 
137
binmode(STDERR, ':utf8')
 
138
   or die "Can't binmode(STDERR, ':utf8'): $OS_ERROR";
 
139
 
 
140
# Prevent "Wide character in print at Test/Builder.pm" warnings.
 
141
binmode Test::More->builder->$_(), ':encoding(UTF-8)'
 
142
   for qw(output failure_output);
 
143
 
 
144
my @latin1_serialize_tests = (
 
145
   [ 'a' ],
154
146
   [ 'a', 'b', ],
155
 
   [ 'a,', 'b', ],
156
 
   [ "a,\\\nc\nas", 'b', ],
157
 
   [ 'a\\\,a', 'c', ],
158
 
   [ 'a\\\\,a', 'c', ],
159
 
   [ 'a\\\\\,aa', 'c', ],
160
 
   [ 'a\\\\\\,aa', 'c', ],
161
 
   [ 'a\\\,a,a', 'c,d,e,d,', ],
162
 
   [ "\\\,\x{e8},a", '!!!!__!*`,`\\', ], # Latin-1
163
 
   [ "\x{30cb}\\\,\x{e8},a", '!!!!__!*`,`\\', ], # UTF-8
164
 
   [ ",,,,,,,,,,,,,,", ",", ],
165
 
   [ "\\,\\,\\,\\,\\,\\,\\,\\,\\,\\,\\,,,,\\", ":(", ],
166
 
   [ "asdfa", "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\,a", ],
 
147
   [ 'a,', 'b', ],  # trailing comma
 
148
   [ ',a', 'b', ],  # leading comma
 
149
   [ 'a', ',b' ],
 
150
   [ 0 ],
 
151
   [ 0, 0 ],
167
152
   [ 1, 2 ],
168
 
   [ 7, 9 ],
 
153
   [ '' ],  # emptry string
169
154
   [ '', '', '', ],
170
 
   [ '' ],
171
 
   [ undef ],
172
 
);
173
 
 
174
 
use DSNParser;
175
 
use Sandbox;
176
 
my $dp  = new DSNParser(opts=>$dsn_opts);
177
 
my $sb  = new Sandbox(basedir => '/tmp', DSNParser => $dp);
178
 
my $dbh = $sb->get_dbh_for('master');
 
155
   [ undef ],  # NULL
 
156
   [ undef, undef ],
 
157
   [ undef, '' ],
 
158
   [ '\N' ],  # literal \N
 
159
   [ "un caf\x{e9} na\x{ef}ve" ],  # Latin-1
 
160
   [ "\\," ],
 
161
   [ '\\' ],
 
162
   [ q/"abc\\", 'def'/ ],  # Brian's pathalogical case
 
163
);
 
164
 
 
165
my @utf8_serialize_tests = (
 
166
   [ "\x{30cb} \x{e8}" ],  # UTF-8
 
167
);
 
168
 
179
169
SKIP: {
180
 
   skip 'Cannot connect to sandbox master', scalar @serialize_tests unless $dbh;
181
 
 
182
 
   # Prevent "Wide character in print at Test/Builder.pm" warnings.
183
 
   binmode Test::More->builder->$_(), ':encoding(UTF-8)'
184
 
      for qw(output failure_output);
 
170
   skip 'Cannot connect to sandbox master', scalar @latin1_serialize_tests
 
171
      unless $dbh;
185
172
 
186
173
   $dbh->do('CREATE DATABASE IF NOT EXISTS serialize_test');
187
174
   $dbh->do('DROP TABLE IF EXISTS serialize_test.serialize');
188
 
   $dbh->do('CREATE TABLE serialize_test.serialize (id INT, foo TEXT)');
189
 
 
190
 
   my $sth    = $dbh->prepare(
191
 
      "INSERT INTO serialize_test.serialize (id, foo) VALUES (?, ?)"
192
 
   );
193
 
   my $selsth = $dbh->prepare(
194
 
      "SELECT foo FROM serialize_test.serialize WHERE id=? LIMIT 1"
195
 
   );
196
 
 
197
 
   for my $test_index ( 0..$#serialize_tests ) {
198
 
      my $ser = $q->serialize_list( @{$serialize_tests[$test_index]} );
199
 
 
200
 
      # Bit of a hack, but we want to test both of Perl's internal encodings
201
 
      # for correctness.
202
 
      local $dbh->{'mysql_enable_utf8'} = 1 if utf8::is_utf8($ser);
203
 
 
204
 
      $sth->execute($test_index, $ser);
205
 
      $selsth->execute($test_index);
206
 
 
207
 
      my $flat_string =  "["
208
 
                          . join( "][",
209
 
                                                   map { defined($_) ? $_ : '' } @{$serialize_tests[$test_index]}
210
 
                                                        )
211
 
                                          . "]";
212
 
      $flat_string =~ s/\n/\\n/g;
213
 
 
214
 
      # diag($test_index);
215
 
      SKIP: {
216
 
         skip "DBD::mysql version $DBD::mysql::VERSION has utf8 bugs. "
217
 
            . "See https://bugs.launchpad.net/percona-toolkit/+bug/932327",
218
 
            1 if $DBD::mysql::VERSION lt '4' && $test_index == 9;
219
 
         is_deeply(
220
 
            [ $q->deserialize_list($selsth->fetchrow_array()) ],
221
 
            $serialize_tests[$test_index],
222
 
            "Serialize $flat_string"
223
 
         );
224
 
      }
225
 
   }
226
 
 
227
 
   $sth->finish();
228
 
   $selsth->finish();
229
 
 
230
 
   $dbh->do("DROP DATABASE serialize_test");
 
175
   $dbh->do('CREATE TABLE serialize_test.serialize (id INT, textval TEXT, blobval BLOB)');
 
176
 
 
177
   my $sth = $dbh->prepare(
 
178
      "INSERT INTO serialize_test.serialize VALUES (?, ?, ?)"
 
179
   );
 
180
 
 
181
   for my $test_index ( 0..$#latin1_serialize_tests ) {
 
182
 
 
183
      # Flat, friendly name for the test string
 
184
      my $flat_string
 
185
         =  "["
 
186
         . join( "][",
 
187
               map { defined($_) ? $_ : 'undef' }
 
188
               @{$latin1_serialize_tests[$test_index]})
 
189
         . "]";
 
190
      $flat_string =~ s/\n/\\n/g;
 
191
 
 
192
      # INSERT the serialized list of values.
 
193
      my $ser = $q->serialize_list( @{$latin1_serialize_tests[$test_index]} );
 
194
      $sth->execute($test_index, $ser, $ser);
 
195
 
 
196
      # SELECT back the values and deserialize them. 
 
197
      my ($text_string) = $dbh->selectrow_array(
 
198
         "SELECT textval FROM serialize_test.serialize WHERE id=$test_index");
 
199
      my @text_parts = $q->deserialize_list($text_string);
 
200
 
 
201
      is_deeply(
 
202
         \@text_parts,
 
203
         $latin1_serialize_tests[$test_index],
 
204
         "Serialize $flat_string"
 
205
      ) or diag(Dumper($text_string, \@text_parts));
 
206
   }
 
207
};
 
208
 
 
209
my $utf8_dbh = $sb->get_dbh_for('master');
 
210
$utf8_dbh->{mysql_enable_utf8} = 1;
 
211
$utf8_dbh->do("SET NAMES 'utf8'");
 
212
SKIP: {
 
213
   skip 'Cannot connect to sandbox master', scalar @utf8_serialize_tests
 
214
      unless $utf8_dbh;
 
215
   skip 'DBD::mysql 3.0007 has UTF-8 bug', scalar @utf8_serialize_tests
 
216
      if $DBD::mysql::VERSION le '3.0007';
 
217
 
 
218
   $utf8_dbh->do("DROP TABLE serialize_test.serialize");
 
219
   $utf8_dbh->do("CREATE TABLE serialize_test.serialize (id INT, textval TEXT, blobval BLOB) CHARSET='utf8'");
 
220
 
 
221
   my $sth = $utf8_dbh->prepare(
 
222
      "INSERT INTO serialize_test.serialize VALUES (?, ?, ?)"
 
223
   );
 
224
 
 
225
   for my $test_index ( 0..$#utf8_serialize_tests ) {
 
226
 
 
227
      # Flat, friendly name for the test string
 
228
      my $flat_string
 
229
         =  "["
 
230
         . join( "][",
 
231
               map { defined($_) ? $_ : 'undef' }
 
232
               @{$utf8_serialize_tests[$test_index]})
 
233
         . "]";
 
234
      $flat_string =~ s/\n/\\n/g;
 
235
 
 
236
      # INSERT the serialized list of values.
 
237
      my $ser = $q->serialize_list( @{$utf8_serialize_tests[$test_index]} );
 
238
      $sth->execute($test_index, $ser, $ser);
 
239
 
 
240
      # SELECT back the values and deserialize them. 
 
241
      my ($text_string) = $utf8_dbh->selectrow_array(
 
242
         "SELECT textval FROM serialize_test.serialize WHERE id=$test_index");
 
243
      my @text_parts = $q->deserialize_list($text_string);
 
244
 
 
245
      is_deeply(
 
246
         \@text_parts,
 
247
         $utf8_serialize_tests[$test_index],
 
248
         "Serialize UTF-8 $flat_string"
 
249
      ) or diag(Dumper($text_string, \@text_parts));
 
250
   }
 
251
 
 
252
   $utf8_dbh->disconnect();
 
253
};
 
254
 
 
255
# ###########################################################################
 
256
# Done.
 
257
# ###########################################################################
 
258
if ( $dbh ) {
231
259
   $sb->wipe_clean($dbh);
232
260
   $dbh->disconnect();
233
 
};
234
 
 
235
 
# ###########################################################################
236
 
# Done.
237
 
# ###########################################################################
 
261
}
238
262
ok($sb->ok(), "Sandbox servers") or BAIL_OUT(__FILE__ . " broke the sandbox");
239
 
 
240
263
done_testing;