1# This program is copyright 2009-2013 Percona Inc.
2# Feedback and improvements are welcome.
3#
4# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
5# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
6# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
7#
8# This program is free software; you can redistribute it and/or modify it under
9# the terms of the GNU General Public License as published by the Free Software
10# Foundation, version 2; OR the Perl Artistic License.  On UNIX and similar
11# systems, you can issue `man perlgpl' or `man perlartistic' to read these
12# licenses.
13#
14# You should have received a copy of the GNU General Public License along with
15# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
16# Place, Suite 330, Boston, MA  02111-1307  USA.
17# ###########################################################################
18# Percona::Test package
19# ###########################################################################
20{
21# Package: Percona::Test
22# PerconaTest is a collection of helper-subs for Percona Toolkit tests.
23# Any file arguments (like no_diff() $expected_output) are relative to
24# PERCONA_TOOLKIT_BRANCH.  So passing "commont/t/samples/foo" means
25# "PERCONA_TOOLKIT_BRANCH/common/t/samples/foo".  Do not BAIL_OUT() because
26# this terminates the *entire* test process; die instead.  All
27# subs are exported by default, so is the variable $trunk, so there's
28# no need to import() in the test scripts.
29package Percona::Test;
30
31use strict;
32use warnings FATAL => 'all';
33use English qw(-no_match_vars);
34use constant PTDEVDEBUG => $ENV{PTDEVDEBUG} || 0;
35
36use Data::Dumper;
37$Data::Dumper::Indent    = 1;
38$Data::Dumper::Sortkeys  = 1;
39$Data::Dumper::Quotekeys = 0;
40
41use Test::More;
42use Time::HiRes qw(sleep time);
43use File::Temp qw(tempfile);
44use POSIX qw(signal_h);
45
46require Exporter;
47our @ISA         = qw(Exporter);
48our %EXPORT_TAGS = ();
49our @EXPORT_OK   = qw();
50our @EXPORT      = qw(
51   output
52   full_output
53   load_data
54   load_file
55   slurp_file
56   parse_file
57   wait_until
58   wait_for
59   wait_until_slave_running
60   wait_until_no_lag
61   test_log_parser
62   test_protocol_parser
63   test_packet_parser
64   no_diff
65   throws_ok
66   remove_traces
67   test_bash_tool
68   verify_test_data_integrity
69   $trunk
70   $dsn_opts
71   $sandbox_version
72   $can_load_data
73);
74
75our $trunk = $ENV{PERCONA_TOOLKIT_BRANCH};
76
77our $sandbox_version = '';
78eval {
79   chomp(my $v = `$trunk/sandbox/test-env version 2>/dev/null`);
80   $sandbox_version = $v if $v;
81};
82
83our $can_load_data = can_load_data();
84
85our $dsn_opts = [
86   {
87      key  => 'A',
88      desc => 'Default character set',
89      dsn  => 'charset',
90      copy => 1,
91   },
92   {
93      key  => 'D',
94      desc => 'Database to use',
95      dsn  => 'database',
96      copy => 1,
97   },
98   {
99      key  => 'F',
100      desc => 'Only read default options from the given file',
101      dsn  => 'mysql_read_default_file',
102      copy => 1,
103   },
104   {
105      key  => 'h',
106      desc => 'Connect to host',
107      dsn  => 'host',
108      copy => 1,
109   },
110   {
111      key  => 'p',
112      desc => 'Password to use when connecting',
113      dsn  => 'password',
114      copy => 1,
115   },
116   {
117      key  => 'P',
118      desc => 'Port number to use for connection',
119      dsn  => 'port',
120      copy => 1,
121   },
122   {
123      key  => 'S',
124      desc => 'Socket file to use for connection',
125      dsn  => 'mysql_socket',
126      copy => 1,
127   },
128   {
129      key  => 't',
130      desc => 'Table',
131      dsn  => undef,
132      copy => 1,
133   },
134   {
135      key  => 'u',
136      desc => 'User for login if not current user',
137      dsn  => 'user',
138      copy => 1,
139   },
140];
141
142# Runs code, captures and returns its output.
143# Optional arguments:
144#   * file    scalar: capture output to this file (default none)
145#   * stderr  scalar: capture STDERR (default no)
146#   * die     scalar: die if code dies (default no)
147#   * trf     coderef: pass output to this coderef (default none)
148sub output {
149   my ( $code, %args ) = @_;
150   die "I need a code argument" unless $code;
151   my ($file, $stderr, $die, $trf) = @args{qw(file stderr die trf)};
152
153   if ( $args{debug} ) {
154      my $retval = eval { $code->() };
155      warn $EVAL_ERROR if $EVAL_ERROR;
156      return $retval;
157   }
158
159   my $output = '';
160   {
161      if ( $file ) {
162         open *output_fh, '>', $file
163            or die "Cannot open file $file: $OS_ERROR";
164      }
165      else {
166         open *output_fh, '>', \$output
167            or die "Cannot capture output to variable: $OS_ERROR";
168      }
169      local *STDOUT = *output_fh;
170
171      # If capturing STDERR we must dynamically scope (local) STDERR
172      # in the outer scope of the sub.  If we did,
173      #   if ( $args{stderr} ) { local *STDERR; ... }
174      # then STDERR would revert to its original value outside the if
175      # block.
176      local *STDERR     if $args{stderr};  # do in outer scope of this sub
177      *STDERR = *STDOUT if $args{stderr};
178
179      eval { $code->() };
180      if ( $EVAL_ERROR ) {
181         die $EVAL_ERROR if $die;
182         warn $EVAL_ERROR;
183      }
184
185      close *output_fh;
186   }
187
188   select STDOUT;
189
190   # Possible transform output before returning it.  This doesn't work
191   # if output was captured to a file.
192   $output = $trf->($output) if $trf;
193
194   return $output;
195}
196
197# Load data from file and removes spaces.  Used to load tcpdump dumps.
198sub load_data {
199   my ( $file ) = @_;
200   $file = "$trunk/$file";
201   open my $fh, '<', $file or die "Cannot open $file: $OS_ERROR";
202   my $contents = do { local $/ = undef; <$fh> };
203   close $fh;
204   (my $data = join('', $contents =~ m/(.*)/g)) =~ s/\s+//g;
205   return $data;
206}
207
208# Slurp file and return its entire contents.
209sub load_file {
210   my ( $file, %args ) = @_;
211   $file = "$trunk/$file";
212   my $contents = slurp_file($file);
213   chomp $contents if $args{chomp_contents};
214   return $contents;
215}
216
217sub slurp_file {
218   my ($file) = @_;
219   open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR";
220   my $contents = do { local $/ = undef; <$fh> };
221   close $fh;
222   return $contents;
223}
224
225sub parse_file {
226   my ( $file, $p, $ea ) = @_;
227   $file = "$trunk/$file";
228   my @e;
229   eval {
230      open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR";
231      my %args = (
232         next_event => sub { return <$fh>;    },
233         tell       => sub { return tell $fh; },
234         fh         => $fh,
235      );
236      while ( my $e = $p->parse_event(%args) ) {
237         push @e, $e;
238         $ea->aggregate($e) if $ea;
239      }
240      close $fh;
241   };
242   die $EVAL_ERROR if $EVAL_ERROR;
243   return \@e;
244}
245
246# Wait until code returns true.
247sub wait_until {
248   my ( $code, $t, $max_t ) = @_;
249   $t     ||= .20;
250   $max_t ||= 30;
251
252   my $slept = 0;
253   while ( $slept <= $max_t ) {
254      return 1 if $code->();
255      PTDEVDEBUG && _d('wait_until sleeping', $t);
256      sleep $t;
257      $slept += $t;
258      PTDEVDEBUG && _d('wait_until slept', $slept, 'of', $max_t);
259   }
260   return 0;
261}
262
263# Wait t seconds for code to return.
264sub wait_for {
265   my ( $code, $t ) = @_;
266   $t ||= 0;
267   my $mask   = POSIX::SigSet->new(&POSIX::SIGALRM);
268   my $action = POSIX::SigAction->new(
269      sub { die },
270      $mask,
271   );
272   my $oldaction = POSIX::SigAction->new();
273   sigaction(&POSIX::SIGALRM, $action, $oldaction);
274   eval {
275      alarm $t;
276      $code->();
277      alarm 0;
278   };
279   if ( $EVAL_ERROR ) {
280      # alarm was raised
281      return 1;
282   }
283   return 0;
284}
285
286sub wait_for_table {
287   my ($dbh, $tbl, $where) = @_;
288   my $sql = "SELECT 1 FROM $tbl" . ($where ? " WHERE $where LIMIT 1" : "");
289   return wait_until(
290      sub {
291         my $r;
292         eval { $r = $dbh->selectrow_arrayref($sql); };
293         if ( $EVAL_ERROR ) {
294            PTDEVDEBUG && _d('Waiting on', $dbh, 'for table', $tbl,
295               'error:', $EVAL_ERROR);
296            return 0;
297         }
298         if ( $where && (!$r || !scalar @$r) ) {
299            PTDEVDEBUG && _d('Waiting on', $dbh, 'for table', $tbl,
300               'WHERE', $where);
301            return 0;
302         }
303         return 1;
304      },
305   );
306}
307
308sub wait_for_files {
309   my (@files) = @_;
310   return wait_until(
311      sub {
312         foreach my $file (@files) {
313            if ( ! -f $file ) {
314               PTDEVDEBUG && _d('Waiting for file', $file);
315               return 0;
316            }
317         }
318         return 1;
319      },
320   );
321}
322
323sub wait_for_sh {
324   my ($cmd) = @_;
325   return wait_until(
326      sub {
327         my $retval = system("$cmd 2>/dev/null");
328         return $retval >> 8 == 0 ? 1 : 0;
329      }
330   );
331};
332
333sub not_running {
334   my ($cmd) = @_;
335   PTDEVDEBUG && _d('Wait until not running:', $cmd);
336   return wait_until(
337      sub {
338         my $output = `ps x | grep -v grep | grep "$cmd"`;
339         PTDEVDEBUG && _d($output);
340         return 1 unless $output;
341         return 0;
342      }
343   );
344}
345
346sub _read {
347   my ( $fh ) = @_;
348   return <$fh>;
349}
350
351sub test_log_parser {
352   my ( %args ) = @_;
353   foreach my $arg ( qw(parser file) ) {
354      die "I need a $arg argument" unless $args{$arg};
355   }
356   my $p = $args{parser};
357
358   # Make sure caller isn't giving us something we don't understand.
359   # We could ignore it, but then caller might not get the results
360   # they expected.
361   map  { die "What is $_ for?"; }
362   grep { $_ !~ m/^(?:parser|misc|file|result|num_events|oktorun)$/ }
363   keys %args;
364
365   my $file = "$trunk/$args{file}";
366   my @e;
367   eval {
368      open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR";
369      my %parser_args = (
370         next_event => sub { return _read($fh); },
371         tell       => sub { return tell($fh);  },
372         fh         => $fh,
373         misc       => $args{misc},
374         oktorun    => $args{oktorun},
375      );
376      while ( my $e = $p->parse_event(%parser_args) ) {
377         push @e, $e;
378      }
379      close $fh;
380   };
381
382   my ($base_file_name) = $args{file} =~ m/([^\/]+)$/;
383   is(
384      $EVAL_ERROR,
385      '',
386      "$base_file_name: no errors"
387   );
388
389   if ( defined $args{result} ) {
390      is_deeply(
391         \@e,
392         $args{result},
393         "$base_file_name: results"
394      ) or diag(Dumper(\@e));
395   }
396
397   if ( defined $args{num_events} ) {
398      is(
399         scalar @e,
400         $args{num_events},
401         "$base_file_name: $args{num_events} events"
402      );
403   }
404
405   return \@e;
406}
407
408sub test_protocol_parser {
409   my ( %args ) = @_;
410   foreach my $arg ( qw(parser protocol file) ) {
411      die "I need a $arg argument" unless $args{$arg};
412   }
413   my $parser   = $args{parser};
414   my $protocol = $args{protocol};
415
416   # Make sure caller isn't giving us something we don't understand.
417   # We could ignore it, but then caller might not get the results
418   # they expected.
419   map { die "What is $_ for?"; }
420   grep { $_ !~ m/^(?:parser|protocol|misc|file|result|num_events|desc)$/ }
421   keys %args;
422
423   my $file = "$trunk/$args{file}";
424   my @e;
425   eval {
426      open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR";
427      my %parser_args = (
428         next_event => sub { return _read($fh); },
429         tell       => sub { return tell($fh);  },
430         misc       => $args{misc},
431      );
432      while ( my $p = $parser->parse_event(%parser_args) ) {
433         my $e = $protocol->parse_event(%parser_args, event => $p);
434         push @e, $e if $e;
435      }
436      close $fh;
437   };
438
439   my ($base_file_name) = $args{file} =~ m/([^\/]+)$/;
440   is(
441      $EVAL_ERROR,
442      '',
443      "$base_file_name: no errors"
444   );
445
446   if ( defined $args{result} ) {
447      is_deeply(
448         \@e,
449         $args{result},
450         "$base_file_name: " . ($args{desc} || "results")
451      ) or diag(Dumper(\@e));
452   }
453
454   if ( defined $args{num_events} ) {
455      is(
456         scalar @e,
457         $args{num_events},
458         "$base_file_name: $args{num_events} events"
459      );
460   }
461
462   return \@e;
463}
464
465sub test_packet_parser {
466   my ( %args ) = @_;
467   foreach my $arg ( qw(parser file) ) {
468      die "I need a $arg argument" unless $args{$arg};
469   }
470   my $parser   = $args{parser};
471
472   # Make sure caller isn't giving us something we don't understand.
473   # We could ignore it, but then caller might not get the results
474   # they expected.
475   map { die "What is $_ for?"; }
476   grep { $_ !~ m/^(?:parser|misc|file|result|desc|oktorun)$/ }
477   keys %args;
478
479   my $file = "$trunk/$args{file}";
480   my @packets;
481   open my $fh, '<', $file or die "Cannot open $file: $OS_ERROR";
482   my %parser_args = (
483      next_event => sub { return _read($fh); },
484      tell       => sub { return tell($fh);  },
485      misc       => $args{misc},
486      oktorun    => $args{oktorun},
487   );
488   while ( my $packet = $parser->parse_event(%parser_args) ) {
489      push @packets, $packet;
490   }
491
492   # raw_packet is the actual dump text from the file.  It's used
493   # in MySQLProtocolParser but I don't think we need to double-check
494   # it here.  It will make the results very long.
495   foreach my $packet ( @packets ) {
496      delete $packet->{raw_packet};
497   }
498
499   if ( !is_deeply(
500         \@packets,
501         $args{result},
502         "$args{file}" . ($args{desc} ? ": $args{desc}" : '')
503      ) ) {
504      diag(Dumper(\@packets));
505   }
506
507   return;
508}
509
510# no_diff() compares the STDOUT output of a cmd or code to expected output.
511# Returns true if there are no differences between the two outputs,
512# else returns false.  Dies if the cmd/code dies.  Does not capture STDERR.
513# Args:
514#   * cmd                 scalar or coderef: if cmd is a scalar then the
515#                         cmd is ran via the shell.  if it's a coderef then
516#                         the code is ran.  the latter is preferred because
517#                         it generates test coverage.
518#   * expected_output     scalar: file name relative to PERCONA_TOOLKIT_BRANCH
519#   * args                hash: (optional) may include
520#       update_sample            overwrite expected_output with cmd/code output
521#       keep_output              keep last cmd/code output file
522#       transform_result         transform the code to be compared but do not
523#                                reflect these changes on the original file
524#                                if update_sample is passed in
525#       transform_sample         similar to the above, but with the sample
526#                                file
527#   *   trf                      transform cmd/code output before diff
528# The sub dies if cmd or code dies.  STDERR is not captured.
529sub no_diff {
530   my ( $cmd, $expected_output, %args ) = @_;
531   die "I need a cmd argument" unless $cmd;
532   die "I need an expected_output argument" unless $expected_output;
533
534   die "$expected_output does not exist" unless -f "$trunk/$expected_output";
535   $expected_output = "$trunk/$expected_output";
536
537   my $tmp_file      = '/tmp/percona-toolkit-test-output.txt';
538   my $tmp_file_orig = '/tmp/percona-toolkit-test-output-original.txt';
539
540   if ( my $sed_args = $args{sed_out} ) {
541      `cat $expected_output | sed $sed_args > /tmp/pt-test-outfile-trf`;
542      $expected_output = "/tmp/pt-test-outfile-trf";
543   }
544
545   # Determine cmd type and run it.
546   if ( ref $cmd eq 'CODE' ) {
547      output($cmd, file => $tmp_file);
548   }
549   elsif ( $args{cmd_output} ) {
550      # Copy cmd output to tmp file so we don't with the original.
551      open my $tmp_fh, '>', $tmp_file or die "Cannot open $tmp_file: $OS_ERROR";
552      print $tmp_fh $cmd;
553      close $tmp_fh;
554   }
555   else {
556      `$cmd > $tmp_file`;
557   }
558
559   # Do optional arg stuff.
560   `cp $tmp_file $tmp_file_orig`;
561   if ( my $trf = $args{trf} ) {
562      `$trf $tmp_file_orig > $tmp_file`;
563   }
564   if ( my $post_pipe = $args{post_pipe} ) {
565      `cat $tmp_file | $post_pipe > $tmp_file-2`;
566       `mv $tmp_file-2 $tmp_file`;
567   }
568   if ( my $sed_args = $args{sed} ) {
569      foreach my $sed_args ( @{$args{sed}} ) {
570         `cat $tmp_file | sed $sed_args > $tmp_file-2`;
571         `mv $tmp_file-2 $tmp_file`;
572      }
573   }
574   if ( defined(my $sort_args = $args{sort}) ) {
575      `cat $tmp_file | sort $sort_args > $tmp_file-2`;
576      `mv $tmp_file-2 $tmp_file`;
577   }
578
579   my $res_file = $tmp_file;
580   if ( $args{transform_result} ) {
581      (undef, $res_file) = tempfile();
582      output(
583         sub { $args{transform_result}->($tmp_file) },
584         file => $res_file,
585      );
586   }
587
588   my $cmp_file = $expected_output;
589   if ( $args{transform_sample} ) {
590      (undef, $cmp_file) = tempfile();
591      output(
592         sub { $args{transform_sample}->($expected_output) },
593         file => $cmp_file,
594      );
595   }
596
597   # diff the outputs.
598   my $out = `diff $res_file $cmp_file`;
599   my $retval = $?;
600
601   # diff returns 0 if there were no differences,
602   # so !0 = 1 = no diff in our testing parlance.
603   $retval = $retval >> 8;
604
605   if ( $retval ) {
606      diag($out);
607      if ( $ENV{UPDATE_SAMPLES} || $args{update_sample} ) {
608         `cat $tmp_file > $expected_output`;
609         diag("Updated $expected_output");
610      }
611   }
612
613   # Remove our tmp files.
614   `rm -f $tmp_file $tmp_file_orig /tmp/pt-test-outfile-trf >/dev/null 2>&1`
615      unless $ENV{KEEP_OUTPUT} || $args{keep_output};
616
617   if ( $res_file ne $tmp_file ) {
618      1 while unlink $res_file;
619   }
620
621   if ( $cmp_file ne $expected_output ) {
622      1 while unlink $cmp_file;
623   }
624
625   return !$retval;
626}
627
628sub throws_ok {
629   my ( $code, $pat, $msg ) = @_;
630   eval { $code->(); };
631   like ( $EVAL_ERROR, $pat, $msg );
632}
633
634# Remove /*percona-toolkit ...*/ trace comments from the given SQL statement(s).
635# Traces are added in ChangeHandler::process_rows().
636sub remove_traces {
637   my ( $sql ) = @_;
638   my $trace_pat = qr/ \/\*percona-toolkit .+?\*\//;
639   if ( ref $sql && ref $sql eq 'ARRAY' ) {
640      map { $_ =~ s/$trace_pat//gm } @$sql;
641   }
642   else {
643      $sql =~ s/$trace_pat//gm;
644   }
645   return $sql;
646}
647
648sub test_bash_tool {
649   my ( $tool ) = @_;
650   die "I need a tool argument" unless $tool;
651   my $outfile = "/tmp/$tool-test-results.txt";
652   `rm -rf $outfile >/dev/null`;
653   `$trunk/util/test-bash-tool $tool > $outfile`;
654   print `cat $outfile`;
655   return;
656}
657
658my %checksum_result_col = (
659   ts        => 0,
660   errors    => 1,
661   diffs     => 2,
662   rows      => 3,
663   diff_rows => 4,
664   chunks    => 5,
665   skipped   => 5,
666   time      => 6,
667   table     => 7,
668);
669sub count_checksum_results {
670   my ($output, $column, $table) = @_;
671
672   my (@res) = map {
673      my $line = $_;
674      my (@cols) = $line =~ m/(\S+)/g;
675      \@cols;
676   }
677   grep {
678      my $line = $_;
679      if ( !$table ) {
680         $line;
681      }
682      else {
683         $line =~ m/$table$/m ? $line : '';
684      }
685   }
686   grep { m/^\d+\-\d+T\d\d:\d\d:\d\d\s+\d+/ } split /\n/, $output;
687   my $colno = $checksum_result_col{lc $column};
688   die "Invalid checksum result column: $column" unless defined $colno;
689   my $total = 0;
690   map { $total += $_->[$colno] } @res;
691   return $total;
692}
693
694sub normalize_checksum_results {
695   my ($output) = @_;
696   my $tmp_file = "/tmp/test-checksum-results-output";
697   open my $fh, ">", $tmp_file or die "Cannot open $tmp_file: $OS_ERROR";
698   printf $fh $output;
699   close $fh;
700   my $normal_output = `cat $tmp_file | awk '/^[0-9 ]/ {print \$2 " " \$3 " " \$4 " " \$5 " " \$6 " " \$7 " " \$9} /^[A-Z]/ {print \$0}'`;
701   `rm $tmp_file >/dev/null`;
702   return $normal_output;
703}
704
705sub get_master_binlog_pos {
706   my ($dbh) = @_;
707   my $sql = "SHOW MASTER STATUS";
708   my $ms  = $dbh->selectrow_hashref($sql);
709   return $ms->{position};
710}
711
712sub get_slave_pos_relative_to_master {
713   my ($dbh) = @_;
714   my $sql = "SHOW SLAVE STATUS";
715   my $ss  = $dbh->selectrow_hashref($sql);
716   return $ss->{exec_master_log_pos};
717}
718
719# Like output(), but forks a process to execute the coderef.
720# This is because otherwise, errors thrown during cleanup
721# would be skipped.
722sub full_output {
723   my ( $code, %args ) = @_;
724   die "I need a code argument" unless $code;
725
726   local (*STDOUT, *STDERR);
727   require IO::File;
728
729   my (undef, $file) = tempfile();
730   open *STDOUT, '>', $file
731         or die "Cannot open file $file: $OS_ERROR";
732   *STDOUT->autoflush(1);
733
734   my (undef, $file2) = tempfile();
735   open *STDERR, '>', $file2
736      or die "Cannot open file $file2: $OS_ERROR";
737   *STDERR->autoflush(1);
738
739   my $status;
740   if (my $pid = fork) {
741      if ( my $t = $args{wait_for} ) {
742         # Wait for t seconds then kill the child.
743         sleep $t;
744         my $tries = 3;
745         # Most tools require 2 interrupts to make them stop.
746         while ( kill(0, $pid) && $tries-- ) {
747            kill SIGTERM, $pid;
748            sleep 0.10;
749         }
750         # Child didn't respond to SIGTERM?  Then kill -9 it.
751         kill SIGKILL, $pid if kill(0, $pid);
752         sleep 0.25;
753      }
754      waitpid($pid, 0);
755      $status = $? >> 8;
756   }
757   else {
758      exit $code->();
759   }
760   close $_ or die "Cannot close $_: $OS_ERROR" for qw(STDOUT STDERR);
761   my $output = slurp_file($file) . slurp_file($file2);
762
763   unlink $file;
764   unlink $file2;
765
766   return ($output, $status);
767}
768
769sub tables_used {
770   my ($file) = @_;
771   local $INPUT_RECORD_SEPARATOR = '';
772   open my $fh, '<', $file or die "Cannot open $file: $OS_ERROR";
773   my %tables;
774   while ( defined(my $chunk = <$fh>) ) {
775      map {
776         my $db_tbl = $_;
777         $db_tbl =~ s/^\s*`?//;  # strip leading space and `
778         $db_tbl =~ s/\s*`?$//;  # strip trailing space and `
779         $db_tbl =~ s/`\.`/./;   # strip inner `.`
780         $tables{$db_tbl} = 1;
781      }
782      grep {
783         m/(?:\w\.\w|`\.`)/  # only db.tbl, not just db
784      }
785      $chunk =~ m/(?:FROM|INTO|UPDATE)\s+(\S+)/gi;
786   }
787   return [ sort keys %tables ];
788}
789
790sub can_load_data {
791    my $output = `/tmp/12345/use -e "SELECT * FROM percona_test.load_data" 2>/dev/null`;
792    return ($output || '') =~ /1/;
793}
794
795sub _d {
796   my ($package, undef, $line) = caller 0;
797   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
798        map { defined $_ ? $_ : 'undef' }
799        @_;
800   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
801}
802
8031;
804}
805# ###########################################################################
806# End PerconaTest package
807# ###########################################################################
808