Merge lp:~percona-toolkit-dev/percona-toolkit/fix-pqd-distill-bugs into lp:percona-toolkit/2.2

Proposed by Daniel Nichter
Status: Merged
Merged at revision: 585
Proposed branch: lp:~percona-toolkit-dev/percona-toolkit/fix-pqd-distill-bugs
Merge into: lp:percona-toolkit/2.2
Diff against target: 1655 lines (+779/-514)
18 files modified
bin/pt-query-digest (+559/-490)
lib/HTTP/Micro.pm (+1/-1)
lib/QueryParser.pm (+16/-4)
lib/QueryRewriter.pm (+10/-0)
lib/VersionCheck.pm (+2/-2)
t/lib/QueryParser.t (+6/-0)
t/lib/QueryRewriter.t (+28/-0)
t/lib/samples/slowlogs/slow051.txt (+2/-2)
t/lib/samples/slowlogs/slow058.txt (+24/-0)
t/pt-query-digest/binlog_analyses.t (+2/-2)
t/pt-query-digest/daemon.t (+2/-2)
t/pt-query-digest/json.t (+1/-1)
t/pt-query-digest/samples/binlog002.txt (+4/-1)
t/pt-query-digest/samples/empty_report.txt (+2/-0)
t/pt-query-digest/samples/slow051.txt (+5/-5)
t/pt-query-digest/samples/slow058.txt (+94/-0)
t/pt-query-digest/slowlog_analyses.t (+20/-3)
util/update-modules (+1/-1)
To merge this branch: bzr merge lp:~percona-toolkit-dev/percona-toolkit/fix-pqd-distill-bugs
Reviewer Review Type Date Requested Status
Daniel Nichter Approve
Review via email: mp+178434@code.launchpad.net
To post a comment you must log in.
596. By Daniel Nichter

Use new Daemon API.

597. By Daniel Nichter

Fix empty json report test.

598. By Daniel Nichter

Update t/pt-query-digest/binlog_analyses.t now that INSERT without INTO parses correctly.

599. By Daniel Nichter

Fix version check in pqd by calling HTTP::Micro, not old HTTPMicro.

600. By Daniel Nichter

Update/fix binlog_analyses.t for real.

Revision history for this message
Daniel Nichter (daniel-nichter) :
review: Approve

Preview Diff

[H/L] Next/Prev Comment, [J/K] Next/Prev File, [N/P] Next/Prev Hunk
=== modified file 'bin/pt-query-digest'
--- bin/pt-query-digest 2013-07-17 19:41:00 +0000
+++ bin/pt-query-digest 2013-08-03 19:47:33 +0000
@@ -48,7 +48,7 @@
48 FileIterator48 FileIterator
49 Runtime49 Runtime
50 Pipeline50 Pipeline
51 HTTPMicro51 HTTP::Micro
52 VersionCheck52 VersionCheck
53 ));53 ));
54}54}
@@ -2928,6 +2928,13 @@
2928 $query =~ m/\A\s*UNLOCK TABLES/i && return "UNLOCK";2928 $query =~ m/\A\s*UNLOCK TABLES/i && return "UNLOCK";
2929 $query =~ m/\A\s*xa\s+(\S+)/i && return "XA_$1";2929 $query =~ m/\A\s*xa\s+(\S+)/i && return "XA_$1";
29302930
2931 if ( $query =~ m/\A\s*LOAD/i ) {
2932 my ($tbl) = $query =~ m/INTO TABLE\s+(\S+)/i;
2933 $tbl ||= '';
2934 $tbl =~ s/`//g;
2935 return "LOAD DATA $tbl";
2936 }
2937
2931 if ( $query =~ m/\Aadministrator command:/ ) {2938 if ( $query =~ m/\Aadministrator command:/ ) {
2932 $query =~ s/administrator command:/ADMIN/;2939 $query =~ s/administrator command:/ADMIN/;
2933 $query = uc $query;2940 $query = uc $query;
@@ -3021,6 +3028,9 @@
3021 map { $verbs =~ s/$_/$alias_for{$_}/ } keys %alias_for;3028 map { $verbs =~ s/$_/$alias_for{$_}/ } keys %alias_for;
3022 $query = $verbs;3029 $query = $verbs;
3023 }3030 }
3031 elsif ( $verbs && $verbs =~ m/^LOAD DATA/ ) {
3032 return $verbs;
3033 }
3024 else {3034 else {
3025 my @tables = $self->__distill_tables($query, $table, %args);3035 my @tables = $self->__distill_tables($query, $table, %args);
3026 $query = join(q{ }, $verbs, @tables); 3036 $query = join(q{ }, $verbs, @tables);
@@ -8259,7 +8269,7 @@
8259 return ($tbl);8269 return ($tbl);
8260 }8270 }
82618271
8262 $query =~ s/ (?:LOW_PRIORITY|IGNORE|STRAIGHT_JOIN)//ig;8272 $query =~ s/(?:LOW_PRIORITY|IGNORE|STRAIGHT_JOIN|DELAYED)\s+/ /ig;
82638273
8264 if ( $query =~ s/^\s*LOCK TABLES\s+//i ) {8274 if ( $query =~ s/^\s*LOCK TABLES\s+//i ) {
8265 PTDEBUG && _d('Special table type: LOCK TABLES');8275 PTDEBUG && _d('Special table type: LOCK TABLES');
@@ -8268,9 +8278,18 @@
8268 $query = "FROM $query";8278 $query = "FROM $query";
8269 }8279 }
82708280
8271 $query =~ s/\\["']//g; # quoted strings8281 $query =~ s/\\["']//g; # quoted strings
8272 $query =~ s/".*?"/?/sg; # quoted strings8282 $query =~ s/".*?"/?/sg; # quoted strings
8273 $query =~ s/'.*?'/?/sg; # quoted strings8283 $query =~ s/'.*?'/?/sg; # quoted strings
8284
8285 if ( $query =~ m/\A\s*(?:INSERT|REPLACE)(?!\s+INTO)/i ) {
8286 $query =~ s/\A\s*((?:INSERT|REPLACE))\s+/$1 INTO /i;
8287 }
8288
8289 if ( $query =~ m/\A\s*LOAD DATA/i ) {
8290 my ($tbl) = $query =~ m/INTO TABLE\s+(\S+)/i;
8291 return $tbl;
8292 }
82748293
8275 my @tables;8294 my @tables;
8276 foreach my $tbls ( $query =~ m/$tbl_regex/gio ) {8295 foreach my $tbls ( $query =~ m/$tbl_regex/gio ) {
@@ -9253,157 +9272,214 @@
9253use strict;9272use strict;
9254use warnings FATAL => 'all';9273use warnings FATAL => 'all';
9255use English qw(-no_match_vars);9274use English qw(-no_match_vars);
9275
9256use constant PTDEBUG => $ENV{PTDEBUG} || 0;9276use constant PTDEBUG => $ENV{PTDEBUG} || 0;
92579277
9258use POSIX qw(setsid);9278use POSIX qw(setsid);
9279use Fcntl qw(:DEFAULT);
92599280
9260sub new {9281sub new {
9261 my ( $class, %args ) = @_;9282 my ($class, %args) = @_;
9262 foreach my $arg ( qw(o) ) {
9263 die "I need a $arg argument" unless $args{$arg};
9264 }
9265 my $o = $args{o};
9266 my $self = {9283 my $self = {
9267 o => $o,9284 log_file => $args{log_file},
9268 log_file => $o->has('log') ? $o->get('log') : undef,9285 pid_file => $args{pid_file},
9269 PID_file => $o->has('pid') ? $o->get('pid') : undef,9286 daemonize => $args{daemonize},
9287 force_log_file => $args{force_log_file},
9288 parent_exit => $args{parent_exit},
9289 pid_file_owner => 0,
9270 };9290 };
9271
9272 check_PID_file(undef, $self->{PID_file});
9273
9274 PTDEBUG && _d('Daemonized child will log to', $self->{log_file});
9275 return bless $self, $class;9291 return bless $self, $class;
9276}9292}
92779293
9278sub daemonize {9294sub run {
9279 my ( $self ) = @_;9295 my ($self) = @_;
92809296
9281 PTDEBUG && _d('About to fork and daemonize');9297 my $daemonize = $self->{daemonize};
9282 defined (my $pid = fork()) or die "Cannot fork: $OS_ERROR";9298 my $pid_file = $self->{pid_file};
9283 if ( $pid ) {9299 my $log_file = $self->{log_file};
9284 PTDEBUG && _d('Parent PID', $PID, 'exiting after forking child PID',$pid);9300 my $force_log_file = $self->{force_log_file};
9285 exit;9301 my $parent_exit = $self->{parent_exit};
9286 }9302
92879303 PTDEBUG && _d('Starting daemon');
9288 PTDEBUG && _d('Daemonizing child PID', $PID);9304
9289 $self->{PID_owner} = $PID;9305 if ( $pid_file ) {
9290 $self->{child} = 1;9306 eval {
92919307 $self->_make_pid_file(
9292 POSIX::setsid() or die "Cannot start a new session: $OS_ERROR";9308 pid => $PID, # parent's pid
9293 chdir '/' or die "Cannot chdir to /: $OS_ERROR";9309 pid_file => $pid_file,
92949310 );
9295 $self->_make_PID_file();9311 };
92969312 die "$EVAL_ERROR\n" if $EVAL_ERROR;
9297 $OUTPUT_AUTOFLUSH = 1;9313 if ( !$daemonize ) {
92989314 $self->{pid_file_owner} = $PID; # parent's pid
9299 PTDEBUG && _d('Redirecting STDIN to /dev/null');9315 }
9300 close STDIN;9316 }
9301 open STDIN, '/dev/null'9317
9302 or die "Cannot reopen STDIN to /dev/null: $OS_ERROR";9318 if ( $daemonize ) {
93039319 defined (my $child_pid = fork()) or die "Cannot fork: $OS_ERROR";
9304 if ( $self->{log_file} ) {9320 if ( $child_pid ) {
9305 PTDEBUG && _d('Redirecting STDOUT and STDERR to', $self->{log_file});9321 PTDEBUG && _d('Forked child', $child_pid);
9306 close STDOUT;9322 $parent_exit->($child_pid) if $parent_exit;
9307 open STDOUT, '>>', $self->{log_file}9323 exit 0;
9308 or die "Cannot open log file $self->{log_file}: $OS_ERROR";9324 }
93099325
9310 close STDERR;9326 POSIX::setsid() or die "Cannot start a new session: $OS_ERROR";
9311 open STDERR, ">&STDOUT"9327 chdir '/' or die "Cannot chdir to /: $OS_ERROR";
9312 or die "Cannot dupe STDERR to STDOUT: $OS_ERROR"; 9328
9313 }9329 if ( $pid_file ) {
9314 else {9330 $self->_update_pid_file(
9315 if ( -t STDOUT ) {9331 pid => $PID, # child's pid
9316 PTDEBUG && _d('No log file and STDOUT is a terminal;',9332 pid_file => $pid_file,
9317 'redirecting to /dev/null');9333 );
9334 $self->{pid_file_owner} = $PID;
9335 }
9336 }
9337
9338 if ( $daemonize || $force_log_file ) {
9339 PTDEBUG && _d('Redirecting STDIN to /dev/null');
9340 close STDIN;
9341 open STDIN, '/dev/null'
9342 or die "Cannot reopen STDIN to /dev/null: $OS_ERROR";
9343 if ( $log_file ) {
9344 PTDEBUG && _d('Redirecting STDOUT and STDERR to', $log_file);
9318 close STDOUT;9345 close STDOUT;
9319 open STDOUT, '>', '/dev/null'9346 open STDOUT, '>>', $log_file
9320 or die "Cannot reopen STDOUT to /dev/null: $OS_ERROR";9347 or die "Cannot open log file $log_file: $OS_ERROR";
9321 }9348
9322 if ( -t STDERR ) {
9323 PTDEBUG && _d('No log file and STDERR is a terminal;',
9324 'redirecting to /dev/null');
9325 close STDERR;9349 close STDERR;
9326 open STDERR, '>', '/dev/null'9350 open STDERR, ">&STDOUT"
9327 or die "Cannot reopen STDERR to /dev/null: $OS_ERROR";9351 or die "Cannot dupe STDERR to STDOUT: $OS_ERROR";
9328 }9352 }
9329 }9353 else {
93309354 if ( -t STDOUT ) {
9331 return;9355 PTDEBUG && _d('No log file and STDOUT is a terminal;',
9332}9356 'redirecting to /dev/null');
93339357 close STDOUT;
9334sub check_PID_file {9358 open STDOUT, '>', '/dev/null'
9335 my ( $self, $file ) = @_;9359 or die "Cannot reopen STDOUT to /dev/null: $OS_ERROR";
9336 my $PID_file = $self ? $self->{PID_file} : $file;9360 }
9337 PTDEBUG && _d('Checking PID file', $PID_file);9361 if ( -t STDERR ) {
9338 if ( $PID_file && -f $PID_file ) {9362 PTDEBUG && _d('No log file and STDERR is a terminal;',
9339 my $pid;9363 'redirecting to /dev/null');
9340 eval {9364 close STDERR;
9341 chomp($pid = (slurp_file($PID_file) || ''));9365 open STDERR, '>', '/dev/null'
9342 };9366 or die "Cannot reopen STDERR to /dev/null: $OS_ERROR";
9343 if ( $EVAL_ERROR ) {9367 }
9344 die "The PID file $PID_file already exists but it cannot be read: "9368 }
9345 . $EVAL_ERROR;9369
9346 }9370 $OUTPUT_AUTOFLUSH = 1;
9347 PTDEBUG && _d('PID file exists; it contains PID', $pid);9371 }
9348 if ( $pid ) {9372
9349 my $pid_is_alive = kill 0, $pid;9373 PTDEBUG && _d('Daemon running');
9374 return;
9375}
9376
9377sub _make_pid_file {
9378 my ($self, %args) = @_;
9379 my @required_args = qw(pid pid_file);
9380 foreach my $arg ( @required_args ) {
9381 die "I need a $arg argument" unless $args{$arg};
9382 };
9383 my $pid = $args{pid};
9384 my $pid_file = $args{pid_file};
9385
9386 eval {
9387 sysopen(PID_FH, $pid_file, O_RDWR|O_CREAT|O_EXCL) or die $OS_ERROR;
9388 print PID_FH $PID, "\n";
9389 close PID_FH;
9390 };
9391 if ( my $e = $EVAL_ERROR ) {
9392 if ( $e =~ m/file exists/i ) {
9393 my $old_pid = $self->_check_pid_file(
9394 pid_file => $pid_file,
9395 pid => $PID,
9396 );
9397 if ( $old_pid ) {
9398 warn "Overwriting PID file $pid_file because PID $old_pid "
9399 . "is not running.\n";
9400 }
9401 $self->_update_pid_file(
9402 pid => $PID,
9403 pid_file => $pid_file
9404 );
9405 }
9406 else {
9407 die "Error creating PID file $pid_file: $e\n";
9408 }
9409 }
9410
9411 return;
9412}
9413
9414sub _check_pid_file {
9415 my ($self, %args) = @_;
9416 my @required_args = qw(pid_file pid);
9417 foreach my $arg ( @required_args ) {
9418 die "I need a $arg argument" unless $args{$arg};
9419 };
9420 my $pid_file = $args{pid_file};
9421 my $pid = $args{pid};
9422
9423 PTDEBUG && _d('Checking if PID in', $pid_file, 'is running');
9424
9425 if ( ! -f $pid_file ) {
9426 PTDEBUG && _d('PID file', $pid_file, 'does not exist');
9427 return;
9428 }
9429
9430 open my $fh, '<', $pid_file
9431 or die "Error opening $pid_file: $OS_ERROR";
9432 my $existing_pid = do { local $/; <$fh> };
9433 chomp($existing_pid) if $existing_pid;
9434 close $fh
9435 or die "Error closing $pid_file: $OS_ERROR";
9436
9437 if ( $existing_pid ) {
9438 if ( $existing_pid == $pid ) {
9439 warn "The current PID $pid already holds the PID file $pid_file\n";
9440 return;
9441 }
9442 else {
9443 PTDEBUG && _d('Checking if PID', $existing_pid, 'is running');
9444 my $pid_is_alive = kill 0, $existing_pid;
9350 if ( $pid_is_alive ) {9445 if ( $pid_is_alive ) {
9351 die "The PID file $PID_file already exists "9446 die "PID file $pid_file exists and PID $existing_pid is running\n";
9352 . " and the PID that it contains, $pid, is running";9447 }
9353 }
9354 else {
9355 warn "Overwriting PID file $PID_file because the PID that it "
9356 . "contains, $pid, is not running";
9357 }
9358 }
9359 else {
9360 die "The PID file $PID_file already exists but it does not "
9361 . "contain a PID";
9362 }9448 }
9363 }9449 }
9364 else {9450 else {
9365 PTDEBUG && _d('No PID file');9451 die "PID file $pid_file exists but it is empty. Remove the file "
9366 }9452 . "if the process is no longer running.\n";
9367 return;9453 }
9368}9454
93699455 return $existing_pid;
9370sub make_PID_file {9456}
9371 my ( $self ) = @_;9457
9372 if ( exists $self->{child} ) {9458sub _update_pid_file {
9373 die "Do not call Daemon::make_PID_file() for daemonized scripts";9459 my ($self, %args) = @_;
9374 }9460 my @required_args = qw(pid pid_file);
9375 $self->_make_PID_file();9461 foreach my $arg ( @required_args ) {
9376 $self->{PID_owner} = $PID;9462 die "I need a $arg argument" unless $args{$arg};
9377 return;9463 };
9378}9464 my $pid = $args{pid};
93799465 my $pid_file = $args{pid_file};
9380sub _make_PID_file {9466
9381 my ( $self ) = @_;9467 open my $fh, '>', $pid_file
93829468 or die "Cannot open $pid_file: $OS_ERROR";
9383 my $PID_file = $self->{PID_file};9469 print { $fh } $pid, "\n"
9384 if ( !$PID_file ) {9470 or die "Cannot print to $pid_file: $OS_ERROR";
9385 PTDEBUG && _d('No PID file to create');9471 close $fh
9386 return;9472 or warn "Cannot close $pid_file: $OS_ERROR";
9387 }9473
93889474 return;
9389 $self->check_PID_file();9475}
93909476
9391 open my $PID_FH, '>', $PID_file9477sub remove_pid_file {
9392 or die "Cannot open PID file $PID_file: $OS_ERROR";9478 my ($self, $pid_file) = @_;
9393 print $PID_FH $PID9479 $pid_file ||= $self->{pid_file};
9394 or die "Cannot print to PID file $PID_file: $OS_ERROR";9480 if ( $pid_file && -f $pid_file ) {
9395 close $PID_FH9481 unlink $self->{pid_file}
9396 or die "Cannot close PID file $PID_file: $OS_ERROR";9482 or warn "Cannot remove PID file $pid_file: $OS_ERROR";
9397
9398 PTDEBUG && _d('Created PID file:', $self->{PID_file});
9399 return;
9400}
9401
9402sub _remove_PID_file {
9403 my ( $self ) = @_;
9404 if ( $self->{PID_file} && -f $self->{PID_file} ) {
9405 unlink $self->{PID_file}
9406 or warn "Cannot remove PID file $self->{PID_file}: $OS_ERROR";
9407 PTDEBUG && _d('Removed PID file');9483 PTDEBUG && _d('Removed PID file');
9408 }9484 }
9409 else {9485 else {
@@ -9413,20 +9489,15 @@
9413}9489}
94149490
9415sub DESTROY {9491sub DESTROY {
9416 my ( $self ) = @_;9492 my ($self) = @_;
94179493
9418 $self->_remove_PID_file() if ($self->{PID_owner} || 0) == $PID;9494 if ( $self->{pid_file_owner} == $PID ) {
9495 $self->remove_pid_file();
9496 }
94199497
9420 return;9498 return;
9421}9499}
94229500
9423sub slurp_file {
9424 my ($file) = @_;
9425 return unless $file;
9426 open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR";
9427 return do { local $/; <$fh> };
9428}
9429
9430sub _d {9501sub _d {
9431 my ($package, undef, $line) = caller 0;9502 my ($package, undef, $line) = caller 0;
9432 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }9503 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
@@ -11479,25 +11550,23 @@
11479# ###########################################################################11550# ###########################################################################
1148011551
11481# ###########################################################################11552# ###########################################################################
11482# HTTPMicro package11553# HTTP::Micro package
11483# This package is a copy without comments from the original. The original11554# This package is a copy without comments from the original. The original
11484# with comments and its test file can be found in the Bazaar repository at,11555# with comments and its test file can be found in the Bazaar repository at,
11485# lib/HTTPMicro.pm11556# lib/HTTP/Micro.pm
11486# t/lib/HTTPMicro.t11557# t/lib/HTTP/Micro.t
11487# See https://launchpad.net/percona-toolkit for more information.11558# See https://launchpad.net/percona-toolkit for more information.
11488# ###########################################################################11559# ###########################################################################
11489{11560{
1149011561package HTTP::Micro;
11491package HTTPMicro;11562
11492BEGIN {11563our $VERSION = '0.01';
11493 $HTTPMicro::VERSION = '0.001';11564
11494}
11495use strict;11565use strict;
11496use warnings;11566use warnings FATAL => 'all';
1149711567use English qw(-no_match_vars);
11498use Carp ();11568use Carp ();
1149911569
11500
11501my @attributes;11570my @attributes;
11502BEGIN {11571BEGIN {
11503 @attributes = qw(agent timeout);11572 @attributes = qw(agent timeout);
@@ -11568,7 +11637,7 @@
11568 headers => {},11637 headers => {},
11569 };11638 };
1157011639
11571 my $handle = HTTPMicro::Handle->new(timeout => $self->{timeout});11640 my $handle = HTTP::Micro::Handle->new(timeout => $self->{timeout});
1157211641
11573 $handle->connect($scheme, $host, $port);11642 $handle->connect($scheme, $host, $port);
1157411643
@@ -11633,320 +11702,325 @@
11633 return ($scheme, $host, $port, $path_query);11702 return ($scheme, $host, $port, $path_query);
11634}11703}
1163511704
11636package11705} # HTTP::Micro
11637 HTTPMicro::Handle; # hide from PAUSE/indexers11706
11638use strict;11707{
11639use warnings;11708 package HTTP::Micro::Handle;
1164011709
11641use Carp qw[croak];11710 use strict;
11642use Errno qw[EINTR EPIPE];11711 use warnings FATAL => 'all';
11643use IO::Socket qw[SOCK_STREAM];11712 use English qw(-no_match_vars);
1164411713
11645sub BUFSIZE () { 32768 }11714 use Carp qw(croak);
1164611715 use Errno qw(EINTR EPIPE);
11647my $Printable = sub {11716 use IO::Socket qw(SOCK_STREAM);
11648 local $_ = shift;11717
11649 s/\r/\\r/g;11718 sub BUFSIZE () { 32768 }
11650 s/\n/\\n/g;11719
11651 s/\t/\\t/g;11720 my $Printable = sub {
11652 s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;11721 local $_ = shift;
11653 $_;11722 s/\r/\\r/g;
11654};11723 s/\n/\\n/g;
1165511724 s/\t/\\t/g;
11656sub new {11725 s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;
11657 my ($class, %args) = @_;11726 $_;
11658 return bless {11727 };
11659 rbuf => '',11728
11660 timeout => 60,11729 sub new {
11661 max_line_size => 16384,11730 my ($class, %args) = @_;
11662 %args11731 return bless {
11663 }, $class;11732 rbuf => '',
11664}11733 timeout => 60,
1166511734 max_line_size => 16384,
11666my $ssl_verify_args = {11735 %args
11667 check_cn => "when_only",11736 }, $class;
11668 wildcards_in_alt => "anywhere",11737 }
11669 wildcards_in_cn => "anywhere"11738
11670};11739 my $ssl_verify_args = {
1167111740 check_cn => "when_only",
11672sub connect {11741 wildcards_in_alt => "anywhere",
11673 @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/);11742 wildcards_in_cn => "anywhere"
11674 my ($self, $scheme, $host, $port) = @_;11743 };
1167511744
11676 if ( $scheme eq 'https' ) {11745 sub connect {
11677 eval "require IO::Socket::SSL"11746 @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/);
11678 unless exists $INC{'IO/Socket/SSL.pm'};11747 my ($self, $scheme, $host, $port) = @_;
11679 croak(qq/IO::Socket::SSL must be installed for https support\n/)11748
11680 unless $INC{'IO/Socket/SSL.pm'};11749 if ( $scheme eq 'https' ) {
11681 }11750 eval "require IO::Socket::SSL"
11682 elsif ( $scheme ne 'http' ) {11751 unless exists $INC{'IO/Socket/SSL.pm'};
11683 croak(qq/Unsupported URL scheme '$scheme'\n/);11752 croak(qq/IO::Socket::SSL must be installed for https support\n/)
11684 }11753 unless $INC{'IO/Socket/SSL.pm'};
1168511754 }
11686 $self->{fh} = 'IO::Socket::INET'->new(11755 elsif ( $scheme ne 'http' ) {
11687 PeerHost => $host,11756 croak(qq/Unsupported URL scheme '$scheme'\n/);
11688 PeerPort => $port,11757 }
11689 Proto => 'tcp',11758
11690 Type => SOCK_STREAM,11759 $self->{fh} = IO::Socket::INET->new(
11691 Timeout => $self->{timeout}11760 PeerHost => $host,
11692 ) or croak(qq/Could not connect to '$host:$port': $@/);11761 PeerPort => $port,
1169311762 Proto => 'tcp',
11694 binmode($self->{fh})11763 Type => SOCK_STREAM,
11695 or croak(qq/Could not binmode() socket: '$!'/);11764 Timeout => $self->{timeout}
1169611765 ) or croak(qq/Could not connect to '$host:$port': $@/);
11697 if ( $scheme eq 'https') {11766
11698 IO::Socket::SSL->start_SSL($self->{fh});11767 binmode($self->{fh})
11699 ref($self->{fh}) eq 'IO::Socket::SSL'11768 or croak(qq/Could not binmode() socket: '$!'/);
11700 or die(qq/SSL connection failed for $host\n/);11769
11701 if ( $self->{fh}->can("verify_hostname") ) {11770 if ( $scheme eq 'https') {
11702 $self->{fh}->verify_hostname( $host, $ssl_verify_args );11771 IO::Socket::SSL->start_SSL($self->{fh});
11703 }11772 ref($self->{fh}) eq 'IO::Socket::SSL'
11704 else {11773 or die(qq/SSL connection failed for $host\n/);
11705 my $fh = $self->{fh};11774 if ( $self->{fh}->can("verify_hostname") ) {
11706 _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args)11775 $self->{fh}->verify_hostname( $host, $ssl_verify_args );
11707 or die(qq/SSL certificate not valid for $host\n/);11776 }
11708 }11777 else {
11709 }11778 my $fh = $self->{fh};
11710 11779 _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args)
11711 $self->{host} = $host;11780 or die(qq/SSL certificate not valid for $host\n/);
11712 $self->{port} = $port;11781 }
1171311782 }
11714 return $self;11783
11715}11784 $self->{host} = $host;
1171611785 $self->{port} = $port;
11717sub close {11786
11718 @_ == 1 || croak(q/Usage: $handle->close()/);11787 return $self;
11719 my ($self) = @_;11788 }
11720 CORE::close($self->{fh})11789
11721 or croak(qq/Could not close socket: '$!'/);11790 sub close {
11722}11791 @_ == 1 || croak(q/Usage: $handle->close()/);
1172311792 my ($self) = @_;
11724sub write {11793 CORE::close($self->{fh})
11725 @_ == 2 || croak(q/Usage: $handle->write(buf)/);11794 or croak(qq/Could not close socket: '$!'/);
11726 my ($self, $buf) = @_;11795 }
1172711796
11728 my $len = length $buf;11797 sub write {
11729 my $off = 0;11798 @_ == 2 || croak(q/Usage: $handle->write(buf)/);
1173011799 my ($self, $buf) = @_;
11731 local $SIG{PIPE} = 'IGNORE';11800
1173211801 my $len = length $buf;
11733 while () {11802 my $off = 0;
11734 $self->can_write11803
11735 or croak(q/Timed out while waiting for socket to become ready for writing/);11804 local $SIG{PIPE} = 'IGNORE';
11736 my $r = syswrite($self->{fh}, $buf, $len, $off);11805
11737 if (defined $r) {11806 while () {
11738 $len -= $r;11807 $self->can_write
11739 $off += $r;11808 or croak(q/Timed out while waiting for socket to become ready for writing/);
11740 last unless $len > 0;11809 my $r = syswrite($self->{fh}, $buf, $len, $off);
11741 }11810 if (defined $r) {
11742 elsif ($! == EPIPE) {11811 $len -= $r;
11743 croak(qq/Socket closed by remote server: $!/);11812 $off += $r;
11744 }11813 last unless $len > 0;
11745 elsif ($! != EINTR) {11814 }
11746 croak(qq/Could not write to socket: '$!'/);11815 elsif ($! == EPIPE) {
11747 }11816 croak(qq/Socket closed by remote server: $!/);
11748 }11817 }
11749 return $off;11818 elsif ($! != EINTR) {
11750}11819 croak(qq/Could not write to socket: '$!'/);
1175111820 }
11752sub read {11821 }
11753 @_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/);11822 return $off;
11754 my ($self, $len) = @_;11823 }
1175511824
11756 my $buf = '';11825 sub read {
11757 my $got = length $self->{rbuf};11826 @_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/);
1175811827 my ($self, $len) = @_;
11759 if ($got) {11828
11760 my $take = ($got < $len) ? $got : $len;11829 my $buf = '';
11761 $buf = substr($self->{rbuf}, 0, $take, '');11830 my $got = length $self->{rbuf};
11762 $len -= $take;11831
11763 }11832 if ($got) {
1176411833 my $take = ($got < $len) ? $got : $len;
11765 while ($len > 0) {11834 $buf = substr($self->{rbuf}, 0, $take, '');
11766 $self->can_read11835 $len -= $take;
11767 or croak(q/Timed out while waiting for socket to become ready for reading/);11836 }
11768 my $r = sysread($self->{fh}, $buf, $len, length $buf);11837
11769 if (defined $r) {11838 while ($len > 0) {
11770 last unless $r;11839 $self->can_read
11771 $len -= $r;11840 or croak(q/Timed out while waiting for socket to become ready for reading/);
11772 }11841 my $r = sysread($self->{fh}, $buf, $len, length $buf);
11773 elsif ($! != EINTR) {11842 if (defined $r) {
11774 croak(qq/Could not read from socket: '$!'/);11843 last unless $r;
11775 }11844 $len -= $r;
11776 }11845 }
11777 if ($len) {11846 elsif ($! != EINTR) {
11778 croak(q/Unexpected end of stream/);11847 croak(qq/Could not read from socket: '$!'/);
11779 }11848 }
11780 return $buf;11849 }
11781}11850 if ($len) {
1178211851 croak(q/Unexpected end of stream/);
11783sub readline {11852 }
11784 @_ == 1 || croak(q/Usage: $handle->readline()/);11853 return $buf;
11785 my ($self) = @_;11854 }
1178611855
11787 while () {11856 sub readline {
11788 if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {11857 @_ == 1 || croak(q/Usage: $handle->readline()/);
11789 return $1;11858 my ($self) = @_;
11790 }11859
11791 $self->can_read11860 while () {
11792 or croak(q/Timed out while waiting for socket to become ready for reading/);11861 if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {
11793 my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});11862 return $1;
11794 if (defined $r) {11863 }
11795 last unless $r;11864 $self->can_read
11796 }11865 or croak(q/Timed out while waiting for socket to become ready for reading/);
11797 elsif ($! != EINTR) {11866 my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
11798 croak(qq/Could not read from socket: '$!'/);11867 if (defined $r) {
11799 }11868 last unless $r;
11800 }11869 }
11801 croak(q/Unexpected end of stream while looking for line/);11870 elsif ($! != EINTR) {
11802}11871 croak(qq/Could not read from socket: '$!'/);
1180311872 }
11804sub read_header_lines {11873 }
11805 @_ == 1 || @_ == 2 || croak(q/Usage: $handle->read_header_lines([headers])/);11874 croak(q/Unexpected end of stream while looking for line/);
11806 my ($self, $headers) = @_;11875 }
11807 $headers ||= {};11876
11808 my $lines = 0;11877 sub read_header_lines {
11809 my $val;11878 @_ == 1 || @_ == 2 || croak(q/Usage: $handle->read_header_lines([headers])/);
1181011879 my ($self, $headers) = @_;
11811 while () {11880 $headers ||= {};
11812 my $line = $self->readline;11881 my $lines = 0;
1181311882 my $val;
11814 if ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) {11883
11815 my ($field_name) = lc $1;11884 while () {
11816 $val = \($headers->{$field_name} = $2);11885 my $line = $self->readline;
11817 }11886
11818 elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) {11887 if ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) {
11819 $val11888 my ($field_name) = lc $1;
11820 or croak(q/Unexpected header continuation line/);11889 $val = \($headers->{$field_name} = $2);
11821 next unless length $1;11890 }
11822 $$val .= ' ' if length $$val;11891 elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) {
11823 $$val .= $1;11892 $val
11824 }11893 or croak(q/Unexpected header continuation line/);
11825 elsif ($line =~ /\A \x0D?\x0A \z/x) {11894 next unless length $1;
11826 last;11895 $$val .= ' ' if length $$val;
11827 }11896 $$val .= $1;
11828 else {11897 }
11829 croak(q/Malformed header line: / . $Printable->($line));11898 elsif ($line =~ /\A \x0D?\x0A \z/x) {
11830 }11899 last;
11831 }11900 }
11832 return $headers;11901 else {
11833}11902 croak(q/Malformed header line: / . $Printable->($line));
1183411903 }
11835sub write_header_lines {11904 }
11836 (@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/);11905 return $headers;
11837 my($self, $headers) = @_;11906 }
1183811907
11839 my $buf = '';11908 sub write_header_lines {
11840 while (my ($k, $v) = each %$headers) {11909 (@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/);
11841 my $field_name = lc $k;11910 my($self, $headers) = @_;
11842 $field_name =~ /\A [\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]+ \z/x11911
11843 or croak(q/Invalid HTTP header field name: / . $Printable->($field_name));11912 my $buf = '';
11844 $field_name =~ s/\b(\w)/\u$1/g;11913 while (my ($k, $v) = each %$headers) {
11845 $buf .= "$field_name: $v\x0D\x0A";11914 my $field_name = lc $k;
11846 }11915 $field_name =~ /\A [\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]+ \z/x
11847 $buf .= "\x0D\x0A";11916 or croak(q/Invalid HTTP header field name: / . $Printable->($field_name));
11848 return $self->write($buf);11917 $field_name =~ s/\b(\w)/\u$1/g;
11849}11918 $buf .= "$field_name: $v\x0D\x0A";
1185011919 }
11851sub read_content_body {11920 $buf .= "\x0D\x0A";
11852 @_ == 3 || @_ == 4 || croak(q/Usage: $handle->read_content_body(callback, response, [read_length])/);11921 return $self->write($buf);
11853 my ($self, $cb, $response, $len) = @_;11922 }
11854 $len ||= $response->{headers}{'content-length'};11923
1185511924 sub read_content_body {
11856 croak("No content-length in the returned response, and this "11925 @_ == 3 || @_ == 4 || croak(q/Usage: $handle->read_content_body(callback, response, [read_length])/);
11857 . "UA doesn't implement chunking") unless defined $len;11926 my ($self, $cb, $response, $len) = @_;
1185811927 $len ||= $response->{headers}{'content-length'};
11859 while ($len > 0) {11928
11860 my $read = ($len > BUFSIZE) ? BUFSIZE : $len;11929 croak("No content-length in the returned response, and this "
11861 $cb->($self->read($read), $response);11930 . "UA doesn't implement chunking") unless defined $len;
11862 $len -= $read;11931
11863 }11932 while ($len > 0) {
1186411933 my $read = ($len > BUFSIZE) ? BUFSIZE : $len;
11865 return;11934 $cb->($self->read($read), $response);
11866}11935 $len -= $read;
1186711936 }
11868sub write_content_body {11937
11869 @_ == 2 || croak(q/Usage: $handle->write_content_body(request)/);11938 return;
11870 my ($self, $request) = @_;11939 }
11871 my ($len, $content_length) = (0, $request->{headers}{'content-length'});11940
1187211941 sub write_content_body {
11873 $len += $self->write($request->{content});11942 @_ == 2 || croak(q/Usage: $handle->write_content_body(request)/);
1187411943 my ($self, $request) = @_;
11875 $len == $content_length11944 my ($len, $content_length) = (0, $request->{headers}{'content-length'});
11876 or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/);11945
1187711946 $len += $self->write($request->{content});
11878 return $len;11947
11879}11948 $len == $content_length
1188011949 or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/);
11881sub read_response_header {11950
11882 @_ == 1 || croak(q/Usage: $handle->read_response_header()/);11951 return $len;
11883 my ($self) = @_;11952 }
1188411953
11885 my $line = $self->readline;11954 sub read_response_header {
1188611955 @_ == 1 || croak(q/Usage: $handle->read_response_header()/);
11887 $line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x11956 my ($self) = @_;
11888 or croak(q/Malformed Status-Line: / . $Printable->($line));11957
1188911958 my $line = $self->readline;
11890 my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);11959
1189111960 $line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x
11892 return {11961 or croak(q/Malformed Status-Line: / . $Printable->($line));
11893 status => $status,11962
11894 reason => $reason,11963 my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
11895 headers => $self->read_header_lines,11964
11896 protocol => $protocol,11965 return {
11897 };11966 status => $status,
11898}11967 reason => $reason,
1189911968 headers => $self->read_header_lines,
11900sub write_request_header {11969 protocol => $protocol,
11901 @_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/);11970 };
11902 my ($self, $method, $request_uri, $headers) = @_;11971 }
1190311972
11904 return $self->write("$method $request_uri HTTP/1.1\x0D\x0A")11973 sub write_request_header {
11905 + $self->write_header_lines($headers);11974 @_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/);
11906}11975 my ($self, $method, $request_uri, $headers) = @_;
1190711976
11908sub _do_timeout {11977 return $self->write("$method $request_uri HTTP/1.1\x0D\x0A")
11909 my ($self, $type, $timeout) = @_;11978 + $self->write_header_lines($headers);
11910 $timeout = $self->{timeout}11979 }
11911 unless defined $timeout && $timeout >= 0;11980
1191211981 sub _do_timeout {
11913 my $fd = fileno $self->{fh};11982 my ($self, $type, $timeout) = @_;
11914 defined $fd && $fd >= 011983 $timeout = $self->{timeout}
11915 or croak(q/select(2): 'Bad file descriptor'/);11984 unless defined $timeout && $timeout >= 0;
1191611985
11917 my $initial = time;11986 my $fd = fileno $self->{fh};
11918 my $pending = $timeout;11987 defined $fd && $fd >= 0
11919 my $nfound;11988 or croak(q/select(2): 'Bad file descriptor'/);
1192011989
11921 vec(my $fdset = '', $fd, 1) = 1;11990 my $initial = time;
1192211991 my $pending = $timeout;
11923 while () {11992 my $nfound;
11924 $nfound = ($type eq 'read')11993
11925 ? select($fdset, undef, undef, $pending)11994 vec(my $fdset = '', $fd, 1) = 1;
11926 : select(undef, $fdset, undef, $pending) ;11995
11927 if ($nfound == -1) {11996 while () {
11928 $! == EINTR11997 $nfound = ($type eq 'read')
11929 or croak(qq/select(2): '$!'/);11998 ? select($fdset, undef, undef, $pending)
11930 redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;11999 : select(undef, $fdset, undef, $pending) ;
11931 $nfound = 0;12000 if ($nfound == -1) {
11932 }12001 $! == EINTR
11933 last;12002 or croak(qq/select(2): '$!'/);
11934 }12003 redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
11935 $! = 0;12004 $nfound = 0;
11936 return $nfound;12005 }
11937}12006 last;
1193812007 }
11939sub can_read {12008 $! = 0;
11940 @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_read([timeout])/);12009 return $nfound;
11941 my $self = shift;12010 }
11942 return $self->_do_timeout('read', @_)12011
11943}12012 sub can_read {
1194412013 @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_read([timeout])/);
11945sub can_write {12014 my $self = shift;
11946 @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/);12015 return $self->_do_timeout('read', @_)
11947 my $self = shift;12016 }
11948 return $self->_do_timeout('write', @_)12017
11949}12018 sub can_write {
12019 @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/);
12020 my $self = shift;
12021 return $self->_do_timeout('write', @_)
12022 }
12023} # HTTP::Micro::Handle
1195012024
11951my $prog = <<'EOP';12025my $prog = <<'EOP';
11952BEGIN {12026BEGIN {
@@ -11967,6 +12041,7 @@
11967 }12041 }
11968}12042}
11969{12043{
12044 use Carp qw(croak);
11970 my %dispatcher = (12045 my %dispatcher = (
11971 issuer => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_issuer_name( shift )) },12046 issuer => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_issuer_name( shift )) },
11972 subject => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_subject_name( shift )) },12047 subject => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_subject_name( shift )) },
@@ -12122,9 +12197,8 @@
12122}12197}
1212312198
121241;121991;
12125}
12126# ###########################################################################12200# ###########################################################################
12127# End HTTPMicro package12201# End HTTP::Micro package
12128# ###########################################################################12202# ###########################################################################
1212912203
12130# ###########################################################################12204# ###########################################################################
@@ -12158,7 +12232,7 @@
1215812232
12159eval {12233eval {
12160 require Percona::Toolkit;12234 require Percona::Toolkit;
12161 require HTTPMicro;12235 require HTTP::Micro;
12162};12236};
1216312237
12164{12238{
@@ -12389,7 +12463,7 @@
12389 my $url = $args{url};12463 my $url = $args{url};
12390 my $instances = $args{instances};12464 my $instances = $args{instances};
1239112465
12392 my $ua = $args{ua} || HTTPMicro->new( timeout => 3 );12466 my $ua = $args{ua} || HTTP::Micro->new( timeout => 3 );
1239312467
12394 my $response = $ua->request('GET', $url);12468 my $response = $ua->request('GET', $url);
12395 PTDEBUG && _d('Server response:', Dumper($response));12469 PTDEBUG && _d('Server response:', Dumper($response));
@@ -13965,17 +14039,12 @@
13965 # ########################################################################14039 # ########################################################################
13966 # Daemonize now that everything is setup and ready to work.14040 # Daemonize now that everything is setup and ready to work.
13967 # ########################################################################14041 # ########################################################################
13968 my $daemon;14042 my $daemon = Daemon->new(
13969 if ( $o->get('daemonize') ) {14043 daemonize => $o->get('daemonize'),
13970 $daemon = new Daemon(o=>$o);14044 pid_file => $o->get('pid'),
13971 $daemon->daemonize();14045 log_file => $o->get('log'),
13972 PTDEBUG && _d('I am a daemon now');14046 );
13973 }14047 $daemon->run();
13974 elsif ( $o->get('pid') ) {
13975 # We're not daemoninzing, it just handles PID stuff.
13976 $daemon = new Daemon(o=>$o);
13977 $daemon->make_PID_file();
13978 }
1397914048
13980 # ########################################################################14049 # ########################################################################
13981 # Do the version-check14050 # Do the version-check
1398214051
=== modified file 'lib/HTTP/Micro.pm'
--- lib/HTTP/Micro.pm 2013-02-05 17:22:31 +0000
+++ lib/HTTP/Micro.pm 2013-08-03 19:47:33 +0000
@@ -708,5 +708,5 @@
708708
7091;7091;
710# ###########################################################################710# ###########################################################################
711# End HTTPMicro package711# End HTTP::Micro package
712# ###########################################################################712# ###########################################################################
713713
=== modified file 'lib/QueryParser.pm'
--- lib/QueryParser.pm 2013-01-03 00:19:16 +0000
+++ lib/QueryParser.pm 2013-08-03 19:47:33 +0000
@@ -98,7 +98,7 @@
9898
99 # These keywords may appear between UPDATE or SELECT and the table refs.99 # These keywords may appear between UPDATE or SELECT and the table refs.
100 # They need to be removed so that they are not mistaken for tables.100 # They need to be removed so that they are not mistaken for tables.
101 $query =~ s/ (?:LOW_PRIORITY|IGNORE|STRAIGHT_JOIN)//ig;101 $query =~ s/(?:LOW_PRIORITY|IGNORE|STRAIGHT_JOIN|DELAYED)\s+/ /ig;
102102
103 # Another special case: LOCK TABLES tbl [[AS] alias] READ|WRITE, etc.103 # Another special case: LOCK TABLES tbl [[AS] alias] READ|WRITE, etc.
104 # We strip the LOCK TABLES stuff and append "FROM" to fake a SELECT104 # We strip the LOCK TABLES stuff and append "FROM" to fake a SELECT
@@ -110,9 +110,21 @@
110 $query = "FROM $query";110 $query = "FROM $query";
111 }111 }
112112
113 $query =~ s/\\["']//g; # quoted strings113 $query =~ s/\\["']//g; # quoted strings
114 $query =~ s/".*?"/?/sg; # quoted strings114 $query =~ s/".*?"/?/sg; # quoted strings
115 $query =~ s/'.*?'/?/sg; # quoted strings115 $query =~ s/'.*?'/?/sg; # quoted strings
116
117 # INSERT and REPLACE without INTO
118 # https://bugs.launchpad.net/percona-toolkit/+bug/984053
119 if ( $query =~ m/\A\s*(?:INSERT|REPLACE)(?!\s+INTO)/i ) {
120 # Add INTO so the reset of the code work as usual.
121 $query =~ s/\A\s*((?:INSERT|REPLACE))\s+/$1 INTO /i;
122 }
123
124 if ( $query =~ m/\A\s*LOAD DATA/i ) {
125 my ($tbl) = $query =~ m/INTO TABLE\s+(\S+)/i;
126 return $tbl;
127 }
116128
117 my @tables;129 my @tables;
118 foreach my $tbls ( $query =~ m/$tbl_regex/gio ) {130 foreach my $tbls ( $query =~ m/$tbl_regex/gio ) {
119131
=== modified file 'lib/QueryRewriter.pm'
--- lib/QueryRewriter.pm 2013-06-27 18:54:53 +0000
+++ lib/QueryRewriter.pm 2013-08-03 19:47:33 +0000
@@ -246,6 +246,13 @@
246 $query =~ m/\A\s*UNLOCK TABLES/i && return "UNLOCK";246 $query =~ m/\A\s*UNLOCK TABLES/i && return "UNLOCK";
247 $query =~ m/\A\s*xa\s+(\S+)/i && return "XA_$1";247 $query =~ m/\A\s*xa\s+(\S+)/i && return "XA_$1";
248248
249 if ( $query =~ m/\A\s*LOAD/i ) {
250 my ($tbl) = $query =~ m/INTO TABLE\s+(\S+)/i;
251 $tbl ||= '';
252 $tbl =~ s/`//g;
253 return "LOAD DATA $tbl";
254 }
255
249 if ( $query =~ m/\Aadministrator command:/ ) {256 if ( $query =~ m/\Aadministrator command:/ ) {
250 $query =~ s/administrator command:/ADMIN/;257 $query =~ s/administrator command:/ADMIN/;
251 $query = uc $query;258 $query = uc $query;
@@ -386,6 +393,9 @@
386 map { $verbs =~ s/$_/$alias_for{$_}/ } keys %alias_for;393 map { $verbs =~ s/$_/$alias_for{$_}/ } keys %alias_for;
387 $query = $verbs;394 $query = $verbs;
388 }395 }
396 elsif ( $verbs && $verbs =~ m/^LOAD DATA/ ) {
397 return $verbs;
398 }
389 else {399 else {
390 # For everything else, distill the tables.400 # For everything else, distill the tables.
391 my @tables = $self->__distill_tables($query, $table, %args);401 my @tables = $self->__distill_tables($query, $table, %args);
392402
=== modified file 'lib/VersionCheck.pm'
--- lib/VersionCheck.pm 2013-06-17 06:23:11 +0000
+++ lib/VersionCheck.pm 2013-08-03 19:47:33 +0000
@@ -45,7 +45,7 @@
4545
46eval {46eval {
47 require Percona::Toolkit;47 require Percona::Toolkit;
48 require HTTPMicro;48 require HTTP::Micro;
49};49};
5050
51# Return the version check file used to keep track of51# Return the version check file used to keep track of
@@ -335,7 +335,7 @@
335 my $instances = $args{instances};335 my $instances = $args{instances};
336336
337 # Optional args337 # Optional args
338 my $ua = $args{ua} || HTTPMicro->new( timeout => 3 );338 my $ua = $args{ua} || HTTP::Micro->new( timeout => 3 );
339339
340 # GET https://upgrade.percona.com, the server will return340 # GET https://upgrade.percona.com, the server will return
341 # a plaintext list of items/programs it wants the tool341 # a plaintext list of items/programs it wants the tool
342342
=== modified file 't/lib/QueryParser.t'
--- t/lib/QueryParser.t 2012-08-16 22:18:14 +0000
+++ t/lib/QueryParser.t 2013-08-03 19:47:33 +0000
@@ -828,6 +828,12 @@
828 [qw(t1 t2)], 'get_tables works for lowercased LOCK TABLES',828 [qw(t1 t2)], 'get_tables works for lowercased LOCK TABLES',
829);829);
830830
831is_deeply(
832 [ $qp->get_tables("LOAD DATA INFILE '/tmp/foo.txt' INTO TABLE db.tbl") ],
833 [qw(db.tbl)],
834 "LOAD DATA db.tbl"
835);
836
831# #############################################################################837# #############################################################################
832# Done.838# Done.
833# #############################################################################839# #############################################################################
834840
=== modified file 't/lib/QueryRewriter.t'
--- t/lib/QueryRewriter.t 2013-06-27 18:53:06 +0000
+++ t/lib/QueryRewriter.t 2013-08-03 19:47:33 +0000
@@ -1412,6 +1412,34 @@
1412 'distills SELECT with REPLACE function (issue 1176)'1412 'distills SELECT with REPLACE function (issue 1176)'
1413);1413);
14141414
1415# LOAD DATA
1416# https://bugs.launchpad.net/percona-toolkit/+bug/821692
1417# INSERT and REPLACE without INTO
1418# https://bugs.launchpad.net/percona-toolkit/+bug/984053
1419is(
1420 $qr->distill("LOAD DATA LOW_PRIORITY LOCAL INFILE 'file' INTO TABLE tbl"),
1421 "LOAD DATA tbl",
1422 "distill LOAD DATA (bug 821692)"
1423);
1424
1425is(
1426 $qr->distill("LOAD DATA LOW_PRIORITY LOCAL INFILE 'file' INTO TABLE `tbl`"),
1427 "LOAD DATA tbl",
1428 "distill LOAD DATA (bug 821692)"
1429);
1430
1431is(
1432 $qr->distill("insert ignore_bar (id) values (4029731)"),
1433 "INSERT ignore_bar",
1434 "distill INSERT without INTO (bug 984053)"
1435);
1436
1437is(
1438 $qr->distill("replace ignore_bar (id) values (4029731)"),
1439 "REPLACE ignore_bar",
1440 "distill REPLACE without INTO (bug 984053)"
1441);
1442
1415# #############################################################################1443# #############################################################################
1416# Done.1444# Done.
1417# #############################################################################1445# #############################################################################
14181446
=== modified file 't/lib/samples/slowlogs/slow051.txt'
--- t/lib/samples/slowlogs/slow051.txt 2011-06-24 17:22:06 +0000
+++ t/lib/samples/slowlogs/slow051.txt 2013-08-03 19:47:33 +0000
@@ -1,6 +1,6 @@
1# Time: 071218 11:48:271# Time: 071218 11:48:27
2# Query_time: 0.000012 Lock_time: 0.000000 Rows_sent: 0 Rows_examined: 02# Query_time: 0.000012 Lock_time: 0.000000 Rows_sent: 0 Rows_examined: 0
3LOAD DATA INFILE '/tmp/foo.txt' INTO db.tbl;3LOAD DATA INFILE '/tmp/foo.txt' INTO TABLE db.tbl;
4# Time: 071218 11:48:374# Time: 071218 11:48:37
5# Query_time: 0.000012 Lock_time: 0.000000 Rows_sent: 0 Rows_examined: 05# Query_time: 0.000012 Lock_time: 0.000000 Rows_sent: 0 Rows_examined: 0
6LOAD DATA INFILE '/tmp/bar.txt' INTO db.tbl;6LOAD DATA INFILE '/tmp/bar.txt' INTO TABLE db.tbl;
77
=== added file 't/lib/samples/slowlogs/slow058.txt'
--- t/lib/samples/slowlogs/slow058.txt 1970-01-01 00:00:00 +0000
+++ t/lib/samples/slowlogs/slow058.txt 2013-08-03 19:47:33 +0000
@@ -0,0 +1,24 @@
1# User@Host: meow[meow] @ [1.2.3.8]
2# Thread_id: 5 Schema: db
3# Query_time: 0.000002 Lock_time: 0.000000 Rows_sent: 0 Rows_examined: 0
4LOAD DATA LOCAL INFILE '/tmp/foo.txt' INTO TABLE `foo`;
5# User@Host: meow[meow] @ [1.2.3.8]
6# Thread_id: 7 Schema: db
7# Query_time: 0.018799 Lock_time: 0.009453 Rows_sent: 0 Rows_examined: 0
8INSERT `foo` VALUES("bar");
9# User@Host: meow[meow] @ [1.2.3.8]
10# Thread_id: 7 Schema: db
11# Query_time: 0.018799 Lock_time: 0.009453 Rows_sent: 0 Rows_examined: 0
12REPLACE `foo` VALUES("bar");
13# User@Host: meow[meow] @ [1.2.3.8]
14# Thread_id: 5 Schema: db
15# Query_time: 0.000002 Lock_time: 0.000000 Rows_sent: 0 Rows_examined: 0
16load data local infile '/tmp/foo.txt' into table `foo`;
17# User@Host: meow[meow] @ [1.2.3.8]
18# Thread_id: 7 Schema: db
19# Query_time: 0.018799 Lock_time: 0.009453 Rows_sent: 0 Rows_examined: 0
20insert `foo` values("bar");
21# User@Host: meow[meow] @ [1.2.3.8]
22# Thread_id: 7 Schema: db
23# Query_time: 0.018799 Lock_time: 0.009453 Rows_sent: 0 Rows_examined: 0
24replace `foo` values("bar");
025
=== modified file 't/pt-query-digest/binlog_analyses.t'
--- t/pt-query-digest/binlog_analyses.t 2012-11-21 16:58:40 +0000
+++ t/pt-query-digest/binlog_analyses.t 2013-08-03 19:47:33 +0000
@@ -28,7 +28,7 @@
28 "t/pt-query-digest/samples/binlog001.txt"28 "t/pt-query-digest/samples/binlog001.txt"
29 ),29 ),
30 'Analysis for binlog001',30 'Analysis for binlog001',
31);31) or diag($test_diff);
3232
33ok(33ok(
34 no_diff(34 no_diff(
@@ -36,7 +36,7 @@
36 "t/pt-query-digest/samples/binlog002.txt"36 "t/pt-query-digest/samples/binlog002.txt"
37 ),37 ),
38 'Analysis for binlog002',38 'Analysis for binlog002',
39);39) or diag($test_diff);
4040
41# #############################################################################41# #############################################################################
42# Done.42# Done.
4343
=== modified file 't/pt-query-digest/daemon.t'
--- t/pt-query-digest/daemon.t 2012-06-03 19:14:30 +0000
+++ t/pt-query-digest/daemon.t 2013-08-03 19:47:33 +0000
@@ -32,8 +32,8 @@
32$output = `$trunk/bin/pt-query-digest $trunk/commont/t/samples/slow002.txt --pid $pid_file 2>&1`;32$output = `$trunk/bin/pt-query-digest $trunk/commont/t/samples/slow002.txt --pid $pid_file 2>&1`;
33like(33like(
34 $output,34 $output,
35 qr{PID file $pid_file already exists},35 qr{PID file $pid_file exists},
36 'Dies if PID file already exists (--pid without --daemonize) (issue 391)'36 'Dies if PID file exists (--pid without --daemonize) (issue 391)'
37);37);
38`rm $pid_file >/dev/null 2>&1`;38`rm $pid_file >/dev/null 2>&1`;
3939
4040
=== modified file 't/pt-query-digest/json.t'
--- t/pt-query-digest/json.t 2013-07-01 20:59:12 +0000
+++ t/pt-query-digest/json.t 2013-08-03 19:47:33 +0000
@@ -25,7 +25,7 @@
25ok(25ok(
26 no_diff(26 no_diff(
27 sub { pt_query_digest::main(@args, "$sample/slowlogs/empty") },27 sub { pt_query_digest::main(@args, "$sample/slowlogs/empty") },
28 "t/pt-query-digest/samples/empty_report.txt",28 "t/pt-query-digest/samples/empty_json_report.txt",
29 ),29 ),
30 'json output for empty log'30 'json output for empty log'
31) or diag($test_diff);31) or diag($test_diff);
3232
=== modified file 't/pt-query-digest/samples/binlog002.txt'
--- t/pt-query-digest/samples/binlog002.txt 2013-01-11 16:45:20 +0000
+++ t/pt-query-digest/samples/binlog002.txt 2013-08-03 19:47:33 +0000
@@ -89,6 +89,9 @@
89# 100ms89# 100ms
90# 1s90# 1s
91# 10s+91# 10s+
92# Tables
93# SHOW TABLE STATUS FROM `d` LIKE 'foo'\G
94# SHOW CREATE TABLE `d`.`foo`\G
92insert foo values (1) /*... omitted ...*/\G95insert foo values (1) /*... omitted ...*/\G
9396
94# Profile97# Profile
@@ -96,4 +99,4 @@
96# ==== ================== ============= ===== ====== ===== ===============99# ==== ================== ============= ===== ====== ===== ===============
97# 1 0xF25D6D5AC7C18FF3 0.0000 0.0% 1 0.0000 0.00 CREATE DATABASE d100# 1 0xF25D6D5AC7C18FF3 0.0000 0.0% 1 0.0000 0.00 CREATE DATABASE d
98# 2 0x03409022EB8A4AE7 0.0000 0.0% 1 0.0000 0.00 CREATE TABLE foo101# 2 0x03409022EB8A4AE7 0.0000 0.0% 1 0.0000 0.00 CREATE TABLE foo
99# 3 0xF579EC4A9633EEA0 0.0000 0.0% 1 0.0000 0.00 INSERT102# 3 0xF579EC4A9633EEA0 0.0000 0.0% 1 0.0000 0.00 INSERT foo
100103
=== added file 't/pt-query-digest/samples/empty_json_report.txt'
=== modified file 't/pt-query-digest/samples/empty_report.txt'
--- t/pt-query-digest/samples/empty_report.txt 2013-07-01 20:38:34 +0000
+++ t/pt-query-digest/samples/empty_report.txt 2013-08-03 19:47:33 +0000
@@ -0,0 +1,2 @@
1
2# No events processed.
03
=== modified file 't/pt-query-digest/samples/slow051.txt'
--- t/pt-query-digest/samples/slow051.txt 2013-01-11 16:45:20 +0000
+++ t/pt-query-digest/samples/slow051.txt 2013-08-03 19:47:33 +0000
@@ -1,5 +1,5 @@
11
2# Query 1: 0.20 QPS, 0.00x concurrency, ID 0xD989521B246E945B at byte 1462# Query 1: 0.20 QPS, 0.00x concurrency, ID 0x14354E1D979884B4 at byte 152
3# This item is included in the report because it matches --limit.3# This item is included in the report because it matches --limit.
4# Scores: V/M = 0.004# Scores: V/M = 0.00
5# Time range: 2007-12-18 11:48:27 to 11:48:375# Time range: 2007-12-18 11:48:27 to 11:48:37
@@ -10,7 +10,7 @@
10# Lock time 0 0 0 0 0 0 0 010# Lock time 0 0 0 0 0 0 0 0
11# Rows sent 0 0 0 0 0 0 0 011# Rows sent 0 0 0 0 0 0 0 0
12# Rows examine 0 0 0 0 0 0 0 012# Rows examine 0 0 0 0 0 0 0 0
13# Query size 100 86 43 43 43 43 0 4313# Query size 100 98 49 49 49 49 0 49
14# Query_time distribution14# Query_time distribution
15# 1us15# 1us
16# 10us ################################################################16# 10us ################################################################
@@ -23,9 +23,9 @@
23# Tables23# Tables
24# SHOW TABLE STATUS FROM `db` LIKE 'tbl'\G24# SHOW TABLE STATUS FROM `db` LIKE 'tbl'\G
25# SHOW CREATE TABLE `db`.`tbl`\G25# SHOW CREATE TABLE `db`.`tbl`\G
26LOAD DATA INFILE '/tmp/bar.txt' INTO db.tbl\G26LOAD DATA INFILE '/tmp/bar.txt' INTO TABLE db.tbl\G
2727
28# Profile28# Profile
29# Rank Query ID Response time Calls R/Call V/M Item29# Rank Query ID Response time Calls R/Call V/M Item
30# ==== ================== ============= ===== ====== ===== ======30# ==== ================== ============= ===== ====== ===== ===============
31# 1 0xD989521B246E945B 0.0000 100.0% 2 0.0000 0.00 db.tbl31# 1 0x14354E1D979884B4 0.0000 100.0% 2 0.0000 0.00 LOAD DATA db.tbl
3232
=== added file 't/pt-query-digest/samples/slow058.txt'
--- t/pt-query-digest/samples/slow058.txt 1970-01-01 00:00:00 +0000
+++ t/pt-query-digest/samples/slow058.txt 2013-08-03 19:47:33 +0000
@@ -0,0 +1,94 @@
1
2# Query 1: 0 QPS, 0x concurrency, ID 0x471A0C4BD7A4EE34 at byte 730 ______
3# This item is included in the report because it matches --limit.
4# Scores: V/M = 0.00
5# Attribute pct total min max avg 95% stddev median
6# ============ === ======= ======= ======= ======= ======= ======= =======
7# Count 33 2
8# Exec time 49 38ms 19ms 19ms 19ms 19ms 0 19ms
9# Lock time 50 19ms 9ms 9ms 9ms 9ms 0 9ms
10# Rows sent 0 0 0 0 0 0 0 0
11# Rows examine 0 0 0 0 0 0 0 0
12# Query size 24 52 26 26 26 26 0 26
13# String:
14# Databases db
15# Hosts
16# Users meow
17# Query_time distribution
18# 1us
19# 10us
20# 100us
21# 1ms
22# 10ms ################################################################
23# 100ms
24# 1s
25# 10s+
26# Tables
27# SHOW TABLE STATUS FROM `db` LIKE 'foo'\G
28# SHOW CREATE TABLE `db`.`foo`\G
29insert `foo` values("bar")\G
30
31# Query 2: 0 QPS, 0x concurrency, ID 0xF33473286088142B at byte 898 ______
32# This item is included in the report because it matches --limit.
33# Scores: V/M = 0.00
34# Attribute pct total min max avg 95% stddev median
35# ============ === ======= ======= ======= ======= ======= ======= =======
36# Count 33 2
37# Exec time 49 38ms 19ms 19ms 19ms 19ms 0 19ms
38# Lock time 50 19ms 9ms 9ms 9ms 9ms 0 9ms
39# Rows sent 0 0 0 0 0 0 0 0
40# Rows examine 0 0 0 0 0 0 0 0
41# Query size 25 54 27 27 27 27 0 27
42# String:
43# Databases db
44# Hosts
45# Users meow
46# Query_time distribution
47# 1us
48# 10us
49# 100us
50# 1ms
51# 10ms ################################################################
52# 100ms
53# 1s
54# 10s+
55# Tables
56# SHOW TABLE STATUS FROM `db` LIKE 'foo'\G
57# SHOW CREATE TABLE `db`.`foo`\G
58replace `foo` values("bar")\G
59
60# Query 3: 0 QPS, 0x concurrency, ID 0xEBAC9C76529E62CE at byte 534 ______
61# This item is included in the report because it matches --limit.
62# Scores: V/M = 0.00
63# Attribute pct total min max avg 95% stddev median
64# ============ === ======= ======= ======= ======= ======= ======= =======
65# Count 33 2
66# Exec time 0 4us 2us 2us 2us 2us 0 2us
67# Lock time 0 0 0 0 0 0 0 0
68# Rows sent 0 0 0 0 0 0 0 0
69# Rows examine 0 0 0 0 0 0 0 0
70# Query size 50 108 54 54 54 54 0 54
71# String:
72# Databases db
73# Hosts
74# Users meow
75# Query_time distribution
76# 1us ################################################################
77# 10us
78# 100us
79# 1ms
80# 10ms
81# 100ms
82# 1s
83# 10s+
84# Tables
85# SHOW TABLE STATUS FROM `db` LIKE 'foo'\G
86# SHOW CREATE TABLE `db`.`foo`\G
87load data local infile '/tmp/foo.txt' into table `foo`\G
88
89# Profile
90# Rank Query ID Response time Calls R/Call V/M Item
91# ==== ================== ============= ===== ====== ===== =============
92# 1 0x471A0C4BD7A4EE34 0.0376 50.0% 2 0.0188 0.00 INSERT foo
93# 2 0xF33473286088142B 0.0376 50.0% 2 0.0188 0.00 REPLACE foo
94# 3 0xEBAC9C76529E62CE 0.0000 0.0% 2 0.0000 0.00 LOAD DATA foo
095
=== modified file 't/pt-query-digest/slowlog_analyses.t'
--- t/pt-query-digest/slowlog_analyses.t 2013-06-26 23:16:15 +0000
+++ t/pt-query-digest/slowlog_analyses.t 2013-08-03 19:47:33 +0000
@@ -343,7 +343,7 @@
343 "t/pt-query-digest/samples/slow051.txt",343 "t/pt-query-digest/samples/slow051.txt",
344 ),344 ),
345 'Analysis for slow051 (issue 918)',345 'Analysis for slow051 (issue 918)',
346);346) or diag($test_diff);
347347
348# #############################################################################348# #############################################################################
349# Issue 1124: Make mk-query-digest profile include variance-to-mean ratio349# Issue 1124: Make mk-query-digest profile include variance-to-mean ratio
@@ -394,9 +394,10 @@
394);394);
395395
396# #############################################################################396# #############################################################################
397# Bug 1176010: pt-query-digest should know how to group quoted and unquoted database names397# Bug 1176010: pt-query-digest should know how to group quoted and unquoted
398# database names
398# https://bugs.launchpad.net/percona-toolkit/+bug/1176010399# https://bugs.launchpad.net/percona-toolkit/+bug/1176010
399#############################################################################400# #############################################################################
400ok(401ok(
401 no_diff(402 no_diff(
402 sub { pt_query_digest::main(@args, $sample.'slow057.txt',403 sub { pt_query_digest::main(@args, $sample.'slow057.txt',
@@ -407,6 +408,22 @@
407) or diag($test_diff);408) or diag($test_diff);
408409
409# #############################################################################410# #############################################################################
411# https://bugs.launchpad.net/percona-toolkit/+bug/821692
412# pt-query-digest doesn't distill LOAD DATA correctly
413# https://bugs.launchpad.net/percona-toolkit/+bug/984053
414# pt-query-digest doesn't distill INSERT/REPLACE without INTO correctly
415# #############################################################################
416ok(
417 no_diff(
418 sub { pt_query_digest::main($sample.'slow058.txt',
419 '--report-format', 'query_report,profile', '--limit', '100%',
420 )},
421 "t/pt-query-digest/samples/slow058.txt",
422 ),
423 'Analysis for slow058 (bug 821692, bug 984053)'
424) or diag($test_diff);
425
426# #############################################################################
410# Done.427# Done.
411# #############################################################################428# #############################################################################
412done_testing;429done_testing;
413430
=== modified file 'util/update-modules'
--- util/update-modules 2013-01-17 22:09:52 +0000
+++ util/update-modules 2013-08-03 19:47:33 +0000
@@ -91,7 +91,7 @@
9191
92 $BRANCH/util/extract-package $pkg $pkg_file | grep -v '^ *#' >> $tmp_file92 $BRANCH/util/extract-package $pkg $pkg_file | grep -v '^ *#' >> $tmp_file
9393
94 if [ "$tool_lang" = "perl" ]; then94 if [ "$tool_lang" = "perl" -a $pkg != "HTTP::Micro" ]; then
95 echo "}" >> $tmp_file95 echo "}" >> $tmp_file
96 fi96 fi
9797

Subscribers

People subscribed via source and target branches