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