Skip to content
Snippets Groups Projects

Compare revisions

Changes are shown as if the source revision was being merged into the target revision. Learn more about comparing revisions.

Source

Select target project
No results found
Select Git revision

Target

Select target project
  • ansible/roles/mysql
  • ericzillmann/mysql
2 results
Select Git revision
Show changes
Commits on Source (1)
Hide whitespace changes
Inline Side-by-side
Showing
with 563 additions and 323 deletions
files/pt-query-digest
View file @ 23eed90c
......@@ -56,15 +56,15 @@ BEGIN {
# ###########################################################################
# Percona::Toolkit package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/Percona/Toolkit.pm
# t/lib/Percona/Toolkit.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package Percona::Toolkit;
 
our $VERSION = '3.0.6';
our $VERSION = '3.5.7';
 
use strict;
use warnings FATAL => 'all';
......@@ -105,7 +105,7 @@ sub Dumper {
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : undef }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
......@@ -119,10 +119,10 @@ sub _d {
# ###########################################################################
# Lmo::Utils package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/Lmo/Utils.pm
# t/lib/Lmo/Utils.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package Lmo::Utils;
......@@ -179,10 +179,10 @@ sub _unimport_coderefs {
# ###########################################################################
# Lmo::Meta package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/Lmo/Meta.pm
# t/lib/Lmo/Meta.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package Lmo::Meta;
......@@ -236,10 +236,10 @@ sub attributes_for_new {
# ###########################################################################
# Lmo::Object package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/Lmo/Object.pm
# t/lib/Lmo/Object.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package Lmo::Object;
......@@ -332,10 +332,10 @@ sub meta {
# ###########################################################################
# Lmo::Types package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/Lmo/Types.pm
# t/lib/Lmo/Types.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package Lmo::Types;
......@@ -361,7 +361,7 @@ our %TYPES = (
} qw(Array Code Hash Regexp Glob Scalar)
);
 
sub check_type_constaints {
sub check_type_constraints {
my ($attribute, $type_check, $check_name, $val) = @_;
( ref($type_check) eq 'CODE'
? $type_check->($val)
......@@ -372,7 +372,7 @@ sub check_type_constaints {
|| Carp::confess(
qq<Attribute ($attribute) does not pass the type constraint because: >
. qq<Validation failed for '$check_name' with value >
. (defined $val ? Lmo::Dumper($val) : undef) )
. (defined $val ? Lmo::Dumper($val) : 'undef') )
}
 
sub _nested_constraints {
......@@ -433,10 +433,10 @@ sub _nested_constraints {
# ###########################################################################
# Lmo package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/Lmo.pm
# t/lib/Lmo.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
BEGIN {
......@@ -551,7 +551,7 @@ sub has {
 
my $check_sub = sub {
my ($new_val) = @_;
Lmo::Types::check_type_constaints($attribute, $type_check, $check_name, $new_val);
Lmo::Types::check_type_constraints($attribute, $type_check, $check_name, $new_val);
};
 
$class_metadata->{$attribute}{isa} = [$check_name, $check_sub];
......@@ -768,10 +768,10 @@ sub override {
# ###########################################################################
# DSNParser package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/DSNParser.pm
# t/lib/DSNParser.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package DSNParser;
......@@ -806,7 +806,7 @@ sub new {
}
PTDEBUG && _d('DSN option:',
join(', ',
map { "$_=" . (defined $opt->{$_} ? ($opt->{$_} || '') : undef) }
map { "$_=" . (defined $opt->{$_} ? ($opt->{$_} || '') : 'undef') }
keys %$opt
)
);
......@@ -855,7 +855,7 @@ sub parse {
foreach my $key ( keys %$opts ) {
PTDEBUG && _d('Finding value for', $key);
$final_props{$key} = $given_props{$key};
if ( !defined $final_props{$key}
if ( !defined $final_props{$key}
&& defined $prev->{$key} && $opts->{$key}->{copy} )
{
$final_props{$key} = $prev->{$key};
......@@ -920,7 +920,7 @@ sub usage {
my %opts = %{$self->{opts}};
foreach my $key ( sort keys %opts ) {
$usage .= " $key "
. ($opts{$key}->{copy} ? 'yes ' : no )
. ($opts{$key}->{copy} ? 'yes ' : 'no ')
. ($opts{$key}->{desc} || '[No description]')
. "\n";
}
......@@ -945,7 +945,7 @@ sub get_cxn_params {
grep { defined $info->{$_} }
qw(F h P S A))
. ';mysql_read_default_group=client'
. ($info->{L} ? ';mysql_local_infile=1' : );
. ($info->{L} ? ';mysql_local_infile=1' : '');
}
PTDEBUG && _d($dsn);
return ($dsn, $info->{u}, $info->{p});
......@@ -1053,16 +1053,38 @@ sub get_dbh {
 
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
. ($sql_mode ? ",$sql_mode" : )
. ($sql_mode ? ",$sql_mode" : '')
. '\'*/';
PTDEBUG && _d($dbh, $sql);
eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) {
die "Error setting SQL_QUOTE_SHOW_CREATE, SQL_MODE"
. ($sql_mode ? " and $sql_mode" : )
. ($sql_mode ? " and $sql_mode" : '')
. ": $EVAL_ERROR";
}
}
my ($mysql_version) = eval { $dbh->selectrow_array('SELECT VERSION()') };
if ($EVAL_ERROR) {
die "Cannot get MySQL version: $EVAL_ERROR";
}
my (undef, $character_set_server) = eval { $dbh->selectrow_array("SHOW VARIABLES LIKE 'character_set_server'") };
if ($EVAL_ERROR) {
die "Cannot get MySQL var character_set_server: $EVAL_ERROR";
}
if ($mysql_version =~ m/^(\d+)\.(\d)\.(\d+).*/) {
if ($1 >= 8 && $character_set_server =~ m/^utf8/) {
$dbh->{mysql_enable_utf8} = 1;
my $msg = "MySQL version $mysql_version >= 8 and character_set_server = $character_set_server\n".
"Setting: SET NAMES $character_set_server";
PTDEBUG && _d($msg);
eval { $dbh->do("SET NAMES 'utf8mb4'") };
if ($EVAL_ERROR) {
die "Cannot SET NAMES $character_set_server: $EVAL_ERROR";
}
}
}
 
PTDEBUG && _d('DBH info: ',
$dbh,
......@@ -1098,7 +1120,7 @@ sub print_active_handles {
my ( $self, $thing, $level ) = @_;
$level ||= 0;
printf("# Active %sh: %s %s %s\n", ($thing->{Type} || 'undef'), "\t" x $level,
$thing, (($thing->{Type} || '') eq 'st' ? $thing->{Statement} || '' : ))
$thing, (($thing->{Type} || '') eq 'st' ? $thing->{Statement} || '' : ''))
or die "Cannot print: $OS_ERROR";
foreach my $handle ( grep {defined} @{ $thing->{ChildHandles} } ) {
$self->print_active_handles( $handle, $level + 1 );
......@@ -1177,7 +1199,7 @@ sub set_vars {
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : undef }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
......@@ -1191,10 +1213,10 @@ sub _d {
# ###########################################################################
# Quoter package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/Quoter.pm
# t/lib/Quoter.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package Quoter;
......@@ -1230,6 +1252,8 @@ sub quote_val {
return $val if $val =~ m/^0x[0-9a-fA-F]+$/ # quote hex data
&& !$args{is_char}; # unless is_char is true
 
return $val if $args{is_float};
$val =~ s/(['\\])/\\$1/g;
return "'$val'";
}
......@@ -1328,7 +1352,7 @@ sub deserialize_list {
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : undef }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
......@@ -1342,10 +1366,10 @@ sub _d {
# ###########################################################################
# OptionParser package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/OptionParser.pm
# t/lib/OptionParser.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package OptionParser;
......@@ -1568,8 +1592,8 @@ sub _pod_to_specs {
push @specs, {
spec => $self->{parse_attributes}->($self, $option, \%attribs),
desc => $para
. (defined $attribs{default} ? " (default $attribs{default})" : ),
group => ($attribs{'group'} ? $attribs{'group'} : default),
. (defined $attribs{default} ? " (default $attribs{default})" : ''),
group => ($attribs{'group'} ? $attribs{'group'} : 'default'),
attributes => \%attribs
};
}
......@@ -2201,7 +2225,7 @@ sub print_usage {
my $val = $opt->{value};
my $type = $opt->{type} || '';
my $bool = $opt->{spec} =~ m/^[\w-]+(?:\|[\w-])?!?$/;
$val = $bool ? ( $val ? 'TRUE' : FALSE )
$val = $bool ? ( $val ? 'TRUE' : 'FALSE' )
: !defined $val ? '(No value)'
: $type eq 'd' ? $self->{DSNParser}->as_string($val)
: $type =~ m/H|h/ ? join(',', sort keys %$val)
......@@ -2346,10 +2370,10 @@ sub _parse_attribs {
my ( $self, $option, $attribs ) = @_;
my $types = $self->{types};
return $option
. ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : )
. ($attribs->{'negatable'} ? '!' : )
. ($attribs->{'cumulative'} ? '+' : )
. ($attribs->{'type'} ? '=' . $types->{$attribs->{type}} : );
. ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' )
. ($attribs->{'negatable'} ? '!' : '' )
. ($attribs->{'cumulative'} ? '+' : '' )
. ($attribs->{'type'} ? '=' . $types->{$attribs->{type}} : '' );
}
 
sub _parse_synopsis {
......@@ -2429,7 +2453,7 @@ sub set_vars {
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : undef }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
......@@ -2453,10 +2477,10 @@ if ( PTDEBUG ) {
# ###########################################################################
# Transformers package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/Transformers.pm
# t/lib/Transformers.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package Transformers;
......@@ -2592,7 +2616,7 @@ sub shorten {
return sprintf(
$num =~ m/\./ || $n
? '%1$.'.$p.'f%2$s'
: %1$d,
: '%1$d',
$num, $units[$n]);
}
 
......@@ -2618,7 +2642,7 @@ sub parse_timestamp {
= $val =~ m/^$mysql_ts$/ )
{
return sprintf "%d-%02d-%02d %02d:%02d:"
. (defined $f ? '%09.6f' : %02d),
. (defined $f ? '%09.6f' : '%02d'),
$y + 2000, $m, $d, $h, $i, (defined $f ? $s + $f : $s);
}
elsif ( $val =~ m/^$proper_ts$/ ) {
......@@ -2679,7 +2703,7 @@ sub any_unix_timestamp {
 
sub make_checksum {
my ( $val ) = @_;
my $checksum = uc substr(md5_hex($val), -16);
my $checksum = uc md5_hex($val);
PTDEBUG && _d($checksum, 'checksum for', $val);
return $checksum;
}
......@@ -2730,7 +2754,7 @@ sub hash_to_json {
. ":"
. ( object_to_json( $obj->{$k} ) || value_to_json( $obj->{$k} ) );
}
return '{' . ( @res ? join( ",", @res ) : ' ) . '};
return '{' . ( @res ? join( ",", @res ) : '' ) . '}';
}
 
sub array_to_json {
......@@ -2741,7 +2765,7 @@ sub array_to_json {
push @res, object_to_json($v) || value_to_json($v);
}
 
return '[' . ( @res ? join( ",", @res ) : ' ) . '];
return '[' . ( @res ? join( ",", @res ) : '' ) . ']';
}
 
sub value_to_json {
......@@ -2792,7 +2816,7 @@ sub string_to_json {
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : undef }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
......@@ -2806,10 +2830,10 @@ sub _d {
# ###########################################################################
# QueryRewriter package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/QueryRewriter.pm
# t/lib/QueryRewriter.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package QueryRewriter;
......@@ -2923,9 +2947,13 @@ sub fingerprint {
$query =~ s/\Ause \S+\Z/use ?/i # Abstract the DB in USE
&& return $query;
 
$query =~ s/\\["']//g; # quoted strings
$query =~ s/".*?"/?/sg; # quoted strings
$query =~ s/'.*?'/?/sg; # quoted strings
$query =~ s/([^\\])(\\')/$1/sg;
$query =~ s/([^\\])(\\")/$1/sg;
$query =~ s/\\\\//sg;
$query =~ s/\\'//sg;
$query =~ s/\\"//sg;
$query =~ s/([^\\])(".*?[^\\]?")/$1?/sg;
$query =~ s/([^\\])('.*?[^\\]?')/$1?/sg;
 
$query =~ s/\bfalse\b|\btrue\b/?/isg; # boolean values
 
......@@ -3014,11 +3042,11 @@ sub distill_verbs {
$query =~ s/\s+IF(?:\s+NOT)?\s+EXISTS/ /i;
my ( $obj ) = $query =~ m/$dds.+(DATABASE|TABLE)\b/i;
$obj = uc $obj if $obj;
PTDEBUG && _d('Data def statment:', $dds, 'obj:', $obj);
PTDEBUG && _d('Data def statement:', $dds, 'obj:', $obj);
my ($db_or_tbl)
= $query =~ m/(?:TABLE|DATABASE)\s+($QueryParser::tbl_ident)(\s+.*)?/i;
PTDEBUG && _d('Matches db or table:', $db_or_tbl);
return uc($dds . ($obj ? " $obj" : )), $db_or_tbl;
return uc($dds . ($obj ? " $obj" : '')), $db_or_tbl;
}
 
my @verbs = $query =~ m/\b($verbs)\b/gio;
......@@ -3064,7 +3092,7 @@ sub distill {
if ( $args{generic} ) {
my ($cmd, $arg) = $query =~ m/^(\S+)\s+(\S+)/;
return '' unless $cmd;
$query = (uc $cmd) . ($arg ? " $arg" : );
$query = (uc $cmd) . ($arg ? " $arg" : '');
}
else {
my ($verbs, $table) = $self->distill_verbs($query, %args);
......@@ -3182,8 +3210,8 @@ sub __insert_to_select_with_set {
sub __update_to_select {
my ( $from, $set, $where, $limit ) = @_;
return "select $set from $from "
. ( $where ? "where $where" : )
. ( $limit ? " $limit " : );
. ( $where ? "where $where" : '' )
. ( $limit ? " $limit " : '' );
}
 
sub wrap_in_derived {
......@@ -3197,7 +3225,7 @@ sub wrap_in_derived {
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : undef }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
......@@ -3211,10 +3239,10 @@ sub _d {
# ###########################################################################
# Processlist package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/Processlist.pm
# t/lib/Processlist.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package Processlist;
......@@ -3366,10 +3394,10 @@ sub parse_event {
else {
PTDEBUG && _d('Saving new query, state', $curr->[STATE]);
push @new_cxn, [
@{$curr}[0..7], # proc info
int($query_start), # START
$etime, # ETIME
$time, # FSEEN
@{$curr}[0..7], # proc info
$query_start, # START
$etime, # ETIME
$time, # FSEEN
{ ($curr->[STATE] || "") => 0 }, # PROFILE
];
}
......@@ -3380,10 +3408,10 @@ sub parse_event {
if ( $curr->[INFO] && defined $curr->[TIME] ) {
PTDEBUG && _d('Saving query of new cxn, state', $curr->[STATE]);
push @new_cxn, [
@{$curr}[0..7], # proc info
int($query_start), # START
$etime, # ETIME
$time, # FSEEN
@{$curr}[0..7], # proc info
$query_start, # START
$etime, # ETIME
$time, # FSEEN
{ ($curr->[STATE] || "") => 0 }, # PROFILE
];
}
......@@ -3586,7 +3614,7 @@ sub _find_match_Info {
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : undef }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
......@@ -3600,10 +3628,10 @@ sub _d {
# ###########################################################################
# TcpdumpParser package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/TcpdumpParser.pm
# t/lib/TcpdumpParser.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package TcpdumpParser;
......@@ -3640,6 +3668,7 @@ sub parse_event {
$pos_in_log -= 1 if $pos_in_log;
 
$raw_packet =~ s/\n20\Z//;
$raw_packet = "20$raw_packet" if $raw_packet =~ /\A20-\d\d-\d\d/; # workaround for year 2020 problem
$raw_packet = "20$raw_packet" unless $raw_packet =~ m/\A20/;
 
$raw_packet =~ s/0x0000:.+?(450.) /0x0000: $1 /;
......@@ -3700,8 +3729,8 @@ sub _parse_packet {
tcp_hlen => $tcp_hlen,
dgram_len => $ip_plen,
data_len => $ip_plen - (($ip_hlen + $tcp_hlen) * 4),
data => $data ? substr($data, 0, 10).(length $data > 10 ? '...' : )
: ,
data => $data ? substr($data, 0, 10).(length $data > 10 ? '...' : '')
: '',
};
PTDEBUG && _d('packet:', Dumper($pkt));
$pkt->{data} = $data;
......@@ -3717,7 +3746,7 @@ sub port_number {
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : undef }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
......@@ -3731,10 +3760,10 @@ sub _d {
# ###########################################################################
# MySQLProtocolParser package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/MySQLProtocolParser.pm
# t/lib/MySQLProtocolParser.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package MySQLProtocolParser;
......@@ -4373,7 +4402,7 @@ sub _packet_from_client {
}
elsif ( ($session->{state} || '') eq 'awaiting_reply' ) {
my $arg = $session->{cmd}->{arg} ? substr($session->{cmd}->{arg}, 0, 50)
: unknown;
: 'unknown';
PTDEBUG && _d('More data for previous command:', $arg, '...');
return;
}
......@@ -4486,8 +4515,8 @@ sub _make_event {
Query_time => timestamp_diff($session->{ts}, $packet->{ts}),
Rows_affected => ($event->{Rows_affected} || 0),
Warning_count => ($event->{Warning_count} || 0),
No_good_index_used => ($event->{No_good_index_used} ? 'Yes' : No),
No_index_used => ($event->{No_index_used} ? 'Yes' : No),
No_good_index_used => ($event->{No_good_index_used} ? 'Yes' : 'No'),
No_index_used => ($event->{No_index_used} ? 'Yes' : 'No'),
};
@{$new_event}{keys %{$session->{attribs}}} = values %{$session->{attribs}};
foreach my $opt_attrib ( qw(Error_no) ) {
......@@ -4542,7 +4571,7 @@ sub unpack_string {
my $len = 0;
my $encode_len = 0;
($data, $len, $encode_len) = decode_len($data);
my $t = 'H' . ($len ? $len * 2 : *);
my $t = 'H' . ($len ? $len * 2 : '*');
$data = pack($t, $data);
return "\"$data\"", $encode_len + $len;
}
......@@ -4747,7 +4776,7 @@ sub parse_client_handshake_packet {
 
my $pkt = {
user => to_string($user),
db => $db ? to_string($db) : ,
db => $db ? to_string($db) : '',
flags => parse_flags($flags),
};
PTDEBUG && _d('Client handshake packet:', Dumper($pkt));
......@@ -4758,7 +4787,7 @@ sub parse_com_packet {
my ( $data, $len ) = @_;
return unless $data && $len;
PTDEBUG && _d('COM data:',
(substr($data, 0, 100).(length $data > 100 ? '...' : )),
(substr($data, 0, 100).(length $data > 100 ? '...' : '')),
'len:', $len);
my $code = substr($data, 0, 2);
my $com = $com_for{$code};
......@@ -4985,7 +5014,7 @@ sub _delete_buff {
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : undef }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
......@@ -4999,10 +5028,10 @@ sub _d {
# ###########################################################################
# SlowLogParser package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/SlowLogParser.pm
# t/lib/SlowLogParser.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package SlowLogParser;
......@@ -5213,7 +5242,7 @@ sub parse_event {
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : undef }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
......@@ -5227,10 +5256,10 @@ sub _d {
# ###########################################################################
# SlowLogWriter package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/SlowLogWriter.pm
# t/lib/SlowLogWriter.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package SlowLogWriter;
......@@ -5246,7 +5275,7 @@ sub new {
}
 
sub write {
my ( $self, $fh, $event ) = @_;
my ( $self, $fh, $event, $field ) = @_;
if ( $event->{ts} ) {
print $fh "# Time: $event->{ts}\n";
}
......@@ -5292,7 +5321,12 @@ sub write {
if ( $event->{arg} =~ m/^administrator command/ ) {
print $fh '# ';
}
print $fh $event->{arg}, ";\n";
if ($field && $event->{$field}) {
print $fh $event->{$field}, ";\n";
} else {
print $fh $event->{arg}, ";\n";
}
 
return;
}
......@@ -5300,7 +5334,7 @@ sub write {
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : undef }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
......@@ -5314,10 +5348,10 @@ sub _d {
# ###########################################################################
# EventAggregator package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/EventAggregator.pm
# t/lib/EventAggregator.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package EventAggregator;
......@@ -5333,8 +5367,6 @@ $Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Quotekeys = 0;
 
use Digest::MD5 qw(md5);
use constant BUCK_SIZE => 1.05;
use constant BASE_LOG => log(BUCK_SIZE);
use constant BASE_OFFSET => abs(1 - log(0.000001) / BASE_LOG); # 284.1617969
......@@ -5588,8 +5620,8 @@ sub make_handler {
);
}
 
my $lt = $type eq 'num' ? '<' : lt;
my $gt = $type eq 'num' ? '>' : gt;
my $lt = $type eq 'num' ? '<' : 'lt';
my $gt = $type eq 'num' ? '>' : 'gt';
foreach my $place ( qw($class $global) ) {
my @tmp; # hold lines until PLACE placeholder is replaced
 
......@@ -5626,7 +5658,7 @@ sub make_handler {
}
 
if ( $args{worst} ) {
my $op = $type eq 'num' ? '>=' : ge;
my $op = $type eq 'num' ? '>=' : 'ge';
push @lines, (
'if ( $val ' . $op . ' ($class->{max} || 0) ) {',
' $samples->{$group_by} = $event;',
......@@ -5860,12 +5892,14 @@ sub top_events {
my ( $self, %args ) = @_;
my $classes = $self->{result_classes};
my @sorted = reverse sort { # Sorted list of $groupby values
$classes->{$a}->{$args{attrib}}->{$args{orderby}}
($classes->{$a}->{$args{attrib}}->{$args{orderby}}
== $classes->{$b}->{$args{attrib}}->{$args{orderby}})
? $a cmp $b
: $classes->{$a}->{$args{attrib}}->{$args{orderby}}
<=> $classes->{$b}->{$args{attrib}}->{$args{orderby}}
|| tiebreaker($classes->{$a}, $classes->{$b});
} grep {
defined $classes->{$_}->{$args{attrib}}->{$args{orderby}}
} keys %$classes; # this should first be sorted for test consistency, but many tests already in place would fail
} keys %$classes;
my @chosen; # top events
my @other; # other events (< top)
my ($total, $count) = (0, 0);
......@@ -5899,15 +5933,6 @@ sub top_events {
return \@chosen, \@other;
}
 
sub tiebreaker {
my ($a, $b) = @_;
if (defined $a->{pos_in_log}) {
return $a->{pos_in_log}->{max} cmp $b->{pos_in_log}->{max};
}
return 0;
}
sub add_new_attributes {
my ( $self, $event ) = @_;
return unless $event;
......@@ -6209,7 +6234,7 @@ sub _get_value {
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : undef }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
......@@ -6223,10 +6248,10 @@ sub _d {
# ###########################################################################
# ReportFormatter package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/ReportFormatter.pm
# t/lib/ReportFormatter.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package ReportFormatter;
......@@ -6332,7 +6357,7 @@ sub BUILDARGS {
if ( ($args->{line_width} || '') eq 'auto' ) {
die "Cannot auto-detect line width because the Term::ReadKey module "
. "is not installed" unless $have_term;
($args->{line_width}) = GetTerminalSize();
($args->{line_width}) = Term::ReadKey::GetTerminalSize();
PTDEBUG && _d('Line width:', $args->{line_width});
}
 
......@@ -6599,7 +6624,7 @@ sub _make_column_formats {
my $width = $col->{right_most} && !$col->{right_justify} ? ''
: $col->{print_width};
 
my $col_fmt = '%' . ($col->{right_justify} ? '' : -') . $width . 's;
my $col_fmt = '%' . ($col->{right_justify} ? '' : '-') . $width . 's';
push @col_fmts, $col_fmt;
}
return @col_fmts;
......@@ -6629,7 +6654,7 @@ sub _column_error {
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : undef }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
......@@ -6644,10 +6669,10 @@ no Lmo;
# ###########################################################################
# QueryReportFormatter package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/QueryReportFormatter.pm
# t/lib/QueryReportFormatter.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package QueryReportFormatter;
......@@ -6728,10 +6753,12 @@ sub BUILDARGS {
shorten => 1024,
report_all => $o->get('report-all'),
report_histogram => $o->get('report-histogram'),
output => $o->got('output') ? $o->get('output') : '',
},
num_format => '# %1$-'.$label_width.'s %2$3s %3$7s %4$7s %5$7s %6$7s %7$7s %8$7s %9$7s',
bool_format => '# %1$-'.$label_width.'s %2$3d%% yes, %3$3d%% no',
string_format => '# %1$-'.$label_width.'s %2$s',
no_partitions => 0,
hidden_attrib => { # Don't sort/print these attribs in the reports.
arg => 1, # They're usually handled specially, or not
fingerprint => 1, # printed at all.
......@@ -6739,6 +6766,12 @@ sub BUILDARGS {
ts => 1,
},
};
if (!defined($self->{max_hostname_length})) {
$self->{max_hostname_length} = MAX_STRING_LENGTH;
}
if (!defined($self->{max_line_length})) {
$self->{max_line_length} = LINE_LENGTH;
}
return $self;
}
 
......@@ -6877,7 +6910,7 @@ sub header {
$store->{sum} / $store->{cnt},
@{$metrics}{qw(pct_95 stddev median)},
);
@values = map { defined $_ ? $func->($_) : } @values;
@values = map { defined $_ ? $func->($_) : '' } @values;
 
push @result,
sprintf $self->{num_format},
......@@ -6923,11 +6956,11 @@ sub query_report_values {
ITEM:
foreach my $top_event ( @$worst ) {
my $item = $top_event->[0];
my $reason = $args{explain_why} ? $top_event->[1] : ;
my $reason = $args{explain_why} ? $top_event->[1] : '';
my $rank = $top_event->[2];
my $stats = $ea->results->{classes}->{$item};
my $sample = $ea->results->{samples}->{$item};
my $samp_query = $sample->{arg} || '';
my $samp_query = ($self->{options}->{output} eq 'secure-slowlog') ? $sample->{fingerprint} || '' : $sample->{arg} || '';
 
my %item_vals = (
item => $item,
......@@ -7009,11 +7042,12 @@ sub query_report {
foreach my $elem ( @{$vals->{review_vals}} ) {
my ($col, $val) = @$elem;
if ( !$val || $val ne '0000-00-00 00:00:00' ) { # issue 202
$report .= sprintf "# %13s: %-s\n", $col, ($val ? $val : );
$report .= sprintf "# %13s: %-s\n", $col, ($val ? $val : '');
}
}
}
 
my $partitions_msg = $self->{no_partitions} ? '' : '/*!50100 PARTITIONS*/';
if ( $groupby eq 'fingerprint' ) {
my $samp_query = $qr->shorten($vals->{samp_query}, $self->{options}->{shorten})
if $self->{options}->{shorten};
......@@ -7027,14 +7061,14 @@ sub query_report {
}
 
my $log_type = $args{log_type} || '';
my $mark = $args{no_v_format} ? '' : \G;
my $mark = $args{no_v_format} ? '' : '\G';
 
if ( $item =~ m/^(?:[\(\s]*select|insert|replace)/ ) {
if ( $item =~ m/^(?:insert|replace)/ ) { # No EXPLAIN
$report .= "$samp_query${mark}\n";
}
else {
$report .= "# EXPLAIN /*!50100 PARTITIONS*/\n$samp_query${mark}\n";
$report .= "# EXPLAIN $partitions_msg\n$samp_query${mark}\n";
$report .= $self->explain_report($samp_query, $vals->{default_db});
}
}
......@@ -7043,7 +7077,7 @@ sub query_report {
my $converted = $qr->convert_to_select($samp_query);
if ( $converted
&& $converted =~ m/^[\(\s]*select/i ) {
$report .= "# Converted for EXPLAIN\n# EXPLAIN /*!50100 PARTITIONS*/\n$converted${mark}\n";
$report .= "# Converted for EXPLAIN\n# EXPLAIN $partitions_msg\n$converted${mark}\n";
}
}
}
......@@ -7133,7 +7167,7 @@ sub event_report_values {
$vals->{sum} / $vals->{cnt},
@{$metrics}{qw(pct_95 stddev median)},
);
@values = map { defined $_ ? $func->($_) : } @values;
@values = map { defined $_ ? $func->($_) : '' } @values;
$pct = percentage_of(
$vals->{sum}, $results->{globals}->{$attrib}->{sum});
 
......@@ -7187,7 +7221,7 @@ sub event_report {
 
my $line = sprintf(
'# %s %d: %s QPS, %sx concurrency, ID 0x%s at byte %.f ',
($val->{groupby} eq 'fingerprint' ? 'Query' : Item),
($val->{groupby} eq 'fingerprint' ? 'Query' : 'Item'),
$args{rank} || 0,
shorten($val->{qps}, d=>1_000),
shorten($val->{concurrency}, d=>1_000),
......@@ -7204,7 +7238,7 @@ sub event_report {
if ( $val->{reason} ) {
push @result,
"# This item is included in the report because it matches "
. ($val->{reason} eq 'top' ? '--limit.' : --outliers.);
. ($val->{reason} eq 'top' ? '--limit.' : '--outliers.');
}
 
push @result,
......@@ -7307,7 +7341,7 @@ sub chart_distro {
 
$n_marks = 1 if $n_marks < 1 && $n_vals > 0;
 
my $bar = ($n_marks ? ' ' : ') . '# x $n_marks;
my $bar = ($n_marks ? ' ' : '') . '#' x $n_marks;
push @results, sprintf $bar_fmt, $distro_labels[$i], $bar;
}
 
......@@ -7344,7 +7378,7 @@ sub profile {
cnt => $stats->{Query_time}->{cnt},
sample => $groupby eq 'fingerprint' ?
$qr->distill($samp_query, %{$args{distill_args}}) : $item,
id => $groupby eq 'fingerprint' ? make_checksum($item) : ,
id => $groupby eq 'fingerprint' ? make_checksum($item) : '',
vmr => ($query_time->{stddev}**2) / ($query_time->{avg} || 1),
);
 
......@@ -7355,7 +7389,7 @@ sub profile {
$report->title('Profile');
my @cols = (
{ name => 'Rank', right_justify => 1, },
{ name => 'Query ID', },
{ name => 'Query ID', width => 35 },
{ name => 'Response time', right_justify => 1, },
{ name => 'Calls', right_justify => 1, },
{ name => 'R/Call', right_justify => 1, },
......@@ -7479,7 +7513,7 @@ sub prepared {
? $qr->distill($samp_query, %{$args{distill_args}})
: $item,
id => $groupby eq 'fingerprint' ? make_checksum($item)
: ,
: '',
};
}
}
......@@ -7606,16 +7640,19 @@ sub format_string_list {
if ( $str =~ m/(?:\d+\.){3}\d+/ ) {
$print_str = $str; # Do not shorten IP addresses.
}
elsif ( length $str > MAX_STRING_LENGTH ) {
$print_str = substr($str, 0, MAX_STRING_LENGTH) . '...';
}
else {
elsif ( $self->{max_hostname_length} > 0 and length $str > $self->{max_hostname_length} ) {
$print_str = substr($str, 0, $self->{max_hostname_length}) . '...';
} else {
$print_str = $str;
}
my $p = percentage_of($cnt_for->{$str}, $class_cnt);
$print_str .= " ($cnt_for->{$str}/$p%)";
if ( !$show_all->{$attrib} ) {
last if (length $line) + (length $print_str) > LINE_LENGTH - 27;
my $trim_length = LINE_LENGTH;
if ($self->{max_hostname_length} == 0 or $self->{max_hostname_length} > LINE_LENGTH) {
$trim_length = $self->{max_hostname_length};
}
if ( $self->{max_line_length} > 0 and !$show_all->{$attrib} ) {
last if (length $line) + (length $print_str) > $self->{max_line_length} - 27;
}
$line .= "$print_str, ";
$i++;
......@@ -7717,11 +7754,11 @@ sub tables_report {
return '' unless @$tables_ref;
my $q = $self->Quoter();
my $tables = "";
my $mark = $args_ref->{no_v_format} ? '' : \G;
my $mark = $args_ref->{no_v_format} ? '' : '\G';
foreach my $db_tbl ( @$tables_ref ) {
my ( $db, $tbl ) = @$db_tbl;
$tables .= '# SHOW TABLE STATUS'
. ($db ? " FROM `$db`" : )
. ($db ? " FROM `$db`" : '')
. " LIKE '$tbl'${mark}\n";
$tables .= "# SHOW CREATE TABLE "
. $q->quote(grep { $_ } @$db_tbl)
......@@ -7746,15 +7783,25 @@ sub explain_report {
PTDEBUG && _d($dbh, "USE", $db);
$dbh->do("USE " . $q->quote($db));
}
my $sth = $dbh->prepare("EXPLAIN /*!50100 PARTITIONS */ $query");
my $sth;
eval {
$sth = $dbh->prepare("EXPLAIN /*!50100 PARTITIONS*/ $query");
$sth->execute();
};
if ($EVAL_ERROR) { # MySQL 8.0+ doesn't support PARTITIONS
$self->{no_partitions} = 1;
$sth = $dbh->prepare("EXPLAIN $query");
$sth->execute();
}
$sth->execute();
my $i = 1;
while ( my @row = $sth->fetchrow_array() ) {
$explain .= "# *************************** $i. "
. "row ***************************\n";
foreach my $j ( 0 .. $#row ) {
$explain .= sprintf "# %13s: %s\n", $sth->{NAME}->[$j],
defined $row[$j] ? $row[$j] : NULL;
my $value_format = $sth->{NAME}->[$j] eq 'filtered' ? "%.02f" : "%s";
$explain .= sprintf "# %13s: $value_format\n", $sth->{NAME}->[$j],
defined $row[$j] ? $row[$j] : 'NULL';
}
$i++; # next row number
}
......@@ -7781,13 +7828,13 @@ sub format_time_range {
(undef, $max) = split(' ', $max);
}
 
return $min && $max ? "$min to $max" : ;
return $min && $max ? "$min to $max" : '';
}
 
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : undef }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
......@@ -7802,10 +7849,10 @@ no Lmo;
# ###########################################################################
# JSONReportFormatter package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/JSONReportFormatter.pm
# t/lib/JSONReportFormatter.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package JSONReportFormatter;
......@@ -8020,6 +8067,7 @@ override query_report => sub {
: undef;
my $fingerprint = substr($item, 0, $self->max_fingerprint_length);
my $checksum = make_checksum($item);
my $explain = $self->explain_report($sample->{arg}, $sample->{db});
my $class = {
checksum => $checksum,
fingerprint => $fingerprint,
......@@ -8031,6 +8079,8 @@ override query_report => sub {
query => substr($sample->{arg}, 0, $self->max_query_length),
ts => $sample->{ts} ? parse_timestamp($sample->{ts}) : undef,
Query_time => $sample->{Query_time},
$explain ?
( explain => $explain ): (),
},
),
};
......@@ -8097,13 +8147,13 @@ override query_report => sub {
default_db => $default_db,
Quoter => $q,
);
my $mark = $args{no_v_format} ? '' : \G;
my $mark = $args{no_v_format} ? '' : '\G';
 
foreach my $db_tbl ( @table_names ) {
my ( $db, $tbl ) = @$db_tbl;
my $status
= 'SHOW TABLE STATUS'
. ($db ? " FROM `$db`" : )
. ($db ? " FROM `$db`" : '')
. " LIKE '$tbl'${mark}";
my $create
= "SHOW CREATE TABLE "
......@@ -8168,10 +8218,10 @@ no Lmo;
# ###########################################################################
# EventTimeline package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/EventTimeline.pm
# t/lib/EventTimeline.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package EventTimeline;
......@@ -8250,12 +8300,12 @@ sub make_handler {
push @lines, q{$val = $val eq 'Yes' ? 1 : 0;};
$type = 'num';
}
my $op = $type eq 'num' ? '<' : lt;
my $op = $type eq 'num' ? '<' : 'lt';
push @lines, (
'$store->{min} = $val if !defined $store->{min} || $val '
. $op . ' $store->{min};',
);
$op = ($type eq 'num') ? '>' : gt;
$op = ($type eq 'num') ? '>' : 'gt';
push @lines, (
'$store->{max} = $val if !defined $store->{max} || $val '
. $op . ' $store->{max};',
......@@ -8326,7 +8376,7 @@ sub report {
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : undef }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
......@@ -8340,10 +8390,10 @@ sub _d {
# ###########################################################################
# QueryParser package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/QueryParser.pm
# t/lib/QueryParser.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package QueryParser;
......@@ -8444,7 +8494,7 @@ sub get_tables {
sub has_derived_table {
my ( $self, $query ) = @_;
my $match = $query =~ m/$has_derived/;
PTDEBUG && _d($query, 'has ' . ($match ? 'a' : no') . ' derived table);
PTDEBUG && _d($query, 'has ' . ($match ? 'a' : 'no') . ' derived table');
return $match;
}
 
......@@ -8546,7 +8596,7 @@ sub split {
}
}
 
PTDEBUG && _d('statements:', map { $_ ? "<$_>" : none } @statements);
PTDEBUG && _d('statements:', map { $_ ? "<$_>" : 'none' } @statements);
return @statements;
}
 
......@@ -8738,7 +8788,7 @@ sub trim_identifier {
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : undef }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
......@@ -8752,10 +8802,10 @@ sub _d {
# ###########################################################################
# TableParser package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/TableParser.pm
# t/lib/TableParser.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package TableParser;
......@@ -8815,13 +8865,15 @@ sub get_create_table {
eval { $href = $dbh->selectrow_hashref($show_sql); };
if ( my $e = $EVAL_ERROR ) {
PTDEBUG && _d($old_sql_mode);
$dbh->do($old_sql_mode);
eval { $dbh->do($old_sql_mode); };
PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR);
 
die $e;
}
 
PTDEBUG && _d($old_sql_mode);
$dbh->do($old_sql_mode);
eval { $dbh->do($old_sql_mode); };
PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR);
 
my ($key) = grep { m/create (?:table|view)/i } keys %$href;
if ( !$key ) {
......@@ -8850,7 +8902,7 @@ sub parse {
 
my $engine = $self->get_engine($ddl);
 
my @defs = $ddl =~ m/^(\s+`.*?),?$/gm;
my @defs = $ddl =~ m/(?:(?<=,\n)|(?<=\(\n))(\s+`(?:.|\n)+?`.+?),?\n/g;
my @cols = map { $_ =~ m/`([^`]+)`/ } @defs;
PTDEBUG && _d('Table cols:', join(', ', map { "`$_`" } @cols));
 
......@@ -8910,9 +8962,10 @@ sub parse {
 
sub remove_quoted_text {
my ($string) = @_;
$string =~ s/[^\\]`[^`]*[^\\]`//g;
$string =~ s/[^\\]"[^"]*[^\\]"//g;
$string =~ s/[^\\]"[^"]*[^\\]"//g;
$string =~ s/\\['"]//g;
$string =~ s/`[^`]*?`//g;
$string =~ s/"[^"]*?"//g;
$string =~ s/'[^']*?'//g;
return $string;
}
 
......@@ -8989,11 +9042,29 @@ sub check_table {
}
my ($dbh, $db, $tbl) = @args{@required_args};
my $q = $self->{Quoter} || 'Quoter';
$self->{check_table_error} = undef;
my $lctn_sql = 'SELECT @@lower_case_table_names';
PTDEBUG && _d($lctn_sql);
my $lower_case_table_names;
eval { ($lower_case_table_names) = $dbh->selectrow_array($lctn_sql); };
if ( $EVAL_ERROR ) {
PTDEBUG && _d($EVAL_ERROR);
$self->{check_table_error} = $EVAL_ERROR;
return 0;
}
PTDEBUG && _d("lower_case_table_names=$lower_case_table_names");
if ($lower_case_table_names > 0) {
PTDEBUG && _d("MySQL uses case-insensitive lookup, converting '$tbl' to lowercase");
$tbl = lc $tbl;
}
my $db_tbl = $q->quote($db, $tbl);
PTDEBUG && _d('Checking', $db_tbl);
 
$self->{check_table_error} = undef;
my $sql = "SHOW TABLES FROM " . $q->quote($db)
. ' LIKE ' . $q->literal_like($tbl);
PTDEBUG && _d($sql);
......@@ -9030,8 +9101,7 @@ sub get_keys {
my $clustered_key = undef;
 
KEY:
foreach my $key ( $ddl =~ m/^ ((?:[A-Z]+ )?KEY .*)$/gm ) {
foreach my $key ( $ddl =~ m/^ ((?:[A-Z]+ )?KEY [\s\S]*?\),?.*)$/gm ) {
next KEY if $key =~ m/FOREIGN/;
 
my $key_ddl = $key;
......@@ -9041,7 +9111,7 @@ sub get_keys {
$key =~ s/USING HASH/USING BTREE/;
}
 
my ( $type, $cols ) = $key =~ m/(?:USING (\w+))? \((.+)\)/;
my ( $type, $cols ) = $key =~ m/(?:USING (\w+))? \(([\s\S]+)\)/;
my ( $special ) = $key =~ m/(FULLTEXT|SPATIAL)/;
$type = $type || $special || 'BTREE';
my ($name) = $key =~ m/(PRIMARY|`[^`]*`)/;
......@@ -9170,7 +9240,7 @@ sub ansi_quote_replace {
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : undef }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
......@@ -9184,10 +9254,10 @@ sub _d {
# ###########################################################################
# QueryReview package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/QueryReview.pm
# t/lib/QueryReview.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package QueryReview;
......@@ -9215,12 +9285,12 @@ sub new {
unless $args{tbl_struct}->{is_col}->{$col};
}
 
my $now = defined $args{ts_default} ? $args{ts_default} : NOW();
my $now = defined $args{ts_default} ? $args{ts_default} : 'NOW()';
 
my $sql = <<" SQL";
INSERT INTO $args{db_tbl}
(checksum, fingerprint, sample, first_seen, last_seen)
VALUES(CONV(?, 16, 10), ?, ?, COALESCE(?, $now), COALESCE(?, $now))
VALUES(?, ?, ?, COALESCE(?, $now), COALESCE(?, $now))
ON DUPLICATE KEY UPDATE
first_seen = IF(
first_seen IS NULL,
......@@ -9237,8 +9307,8 @@ sub new {
my @review_cols = grep { !$skip_cols{$_} } @{$args{tbl_struct}->{cols}};
$sql = "SELECT "
. join(', ', map { $args{quoter}->quote($_) } @review_cols)
. ", CONV(checksum, 10, 16) AS checksum_conv FROM $args{db_tbl}"
. " WHERE checksum=CONV(?, 16, 10)";
. ", checksum AS checksum_conv FROM $args{db_tbl}"
. " WHERE checksum=?";
PTDEBUG && _d('SQL to select from review table:', $sql);
my $select_sth = $args{dbh}->prepare($sql);
 
......@@ -9281,7 +9351,7 @@ sub review_cols {
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : undef }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
......@@ -9295,10 +9365,10 @@ sub _d {
# ###########################################################################
# QueryHistory package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/QueryHistory.pm
# t/lib/QueryHistory.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package QueryHistory;
......@@ -9368,12 +9438,12 @@ sub set_history_options {
my $sql = "REPLACE INTO $args{table}("
. join(', ',
map { Quoter->quote($_) } ('checksum', 'sample', @cols))
. ') VALUES (CONV(?, 16, 10), ?'
. (@cols ? ', ' : ) # issue 1265
. ') VALUES (?, ?'
. (@cols ? ', ' : '') # issue 1265
. join(', ', map {
$_ eq 'ts_min' || $_ eq 'ts_max'
? "COALESCE(?, $ts_default)"
: ?
: '?'
} @cols) . ')';
PTDEBUG && _d($sql);
 
......@@ -9398,7 +9468,7 @@ sub set_review_history {
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : undef }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
......@@ -9412,10 +9482,10 @@ sub _d {
# ###########################################################################
# Daemon package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/Daemon.pm
# t/lib/Daemon.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package Daemon;
......@@ -9652,7 +9722,7 @@ sub DESTROY {
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : undef }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
......@@ -9666,10 +9736,10 @@ sub _d {
# ###########################################################################
# BinaryLogParser package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/BinaryLogParser.pm
# t/lib/BinaryLogParser.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package BinaryLogParser;
......@@ -9855,7 +9925,7 @@ sub parse_event {
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : undef }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
......@@ -9869,10 +9939,10 @@ sub _d {
# ###########################################################################
# GeneralLogParser package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/GeneralLogParser.pm
# t/lib/GeneralLogParser.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package GeneralLogParser;
......@@ -9898,7 +9968,7 @@ sub new {
 
my $genlog_line_1= qr{
\A
(?:(\d{6}\s+\d{1,2}:\d\d:\d\d|\d{4}-\d{1,2}-\d{1,2}T\d\d:\d\d:\d\d\.\d+(?:Z|-?\d\d:\d\d)?))? # Timestamp
(?:(\d{6}\s+\d{1,2}:\d\d:\d\d|\d{4}-\d{1,2}-\d{1,2}T\d\d:\d\d:\d\d\.\d+(?:Z|[-+]?\d\d:\d\d)?))? # Timestamp
\s+
(?:\s*(\d+)) # Thread ID
\s
......@@ -10017,7 +10087,7 @@ sub parse_event {
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : undef }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
......@@ -10031,10 +10101,10 @@ sub _d {
# ###########################################################################
# RawLogParser package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/RawLogParser.pm
# t/lib/RawLogParser.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package RawLogParser;
......@@ -10097,7 +10167,7 @@ sub parse_event {
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : undef }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
......@@ -10111,10 +10181,10 @@ sub _d {
# ###########################################################################
# ProtocolParser package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/ProtocolParser.pm
# t/lib/ProtocolParser.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package ProtocolParser;
......@@ -10409,7 +10479,7 @@ sub uncompress_data {
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : undef }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
......@@ -10423,10 +10493,10 @@ sub _d {
# ###########################################################################
# MasterSlave package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/MasterSlave.pm
# t/lib/MasterSlave.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package MasterSlave;
......@@ -10443,7 +10513,7 @@ sub check_recursion_method {
&& $methods->[0] !~ /^dsn=/i )
{
die "Invalid combination of recursion methods: "
. join(", ", map { defined($_) ? $_ : undef } @$methods) . ". "
. join(", ", map { defined($_) ? $_ : 'undef' } @$methods) . ". "
. "Only hosts and processlist may be combined.\n"
}
}
......@@ -10492,8 +10562,9 @@ sub get_slaves {
$self->recurse_to_slaves(
{ dbh => $dbh,
dsn => $dsn,
slave_user => $o->got('slave-user') ? $o->get('slave-user') : ,
slave_password => $o->got('slave-password') ? $o->get('slave-password') : ,
slave_user => $o->got('slave-user') ? $o->get('slave-user') : '',
slave_password => $o->got('slave-password') ? $o->get('slave-password') : '',
slaves => $args{slaves},
callback => sub {
my ( $dsn, $dbh, $level, $parent ) = @_;
return unless $level;
......@@ -10507,9 +10578,10 @@ sub get_slaves {
$slave_dsn->{p} = $o->get('slave-password');
PTDEBUG && _d("Slave password set");
}
push @$slaves, $make_cxn->(dsn => $slave_dsn, dbh => $dbh);
push @$slaves, $make_cxn->(dsn => $slave_dsn, dbh => $dbh, parent => $parent);
return;
},
wait_no_die => $args{'wait_no_die'},
}
);
} elsif ( $methods->[0] =~ m/^dsn=/i ) {
......@@ -10517,6 +10589,7 @@ sub get_slaves {
$slaves = $self->get_cxn_from_dsn_table(
%args,
dsn_table_dsn => $dsn_table_dsn,
wait_no_die => $args{'wait_no_die'},
);
}
elsif ( $methods->[0] =~ m/none/i ) {
......@@ -10570,21 +10643,54 @@ sub recurse_to_slaves {
PTDEBUG && _d("Slave password set");
}
 
my $dbh;
eval {
$dbh = $args->{dbh} || $dp->get_dbh(
$dp->get_cxn_params($slave_dsn), { AutoCommit => 1 });
PTDEBUG && _d('Connected to', $dp->as_string($slave_dsn));
my $dbh = $args->{dbh};
my $get_dbh = sub {
eval {
$dbh = $dp->get_dbh(
$dp->get_cxn_params($slave_dsn), { AutoCommit => 1 }
);
PTDEBUG && _d('Connected to', $dp->as_string($slave_dsn));
};
if ( $EVAL_ERROR ) {
print STDERR "Cannot connect to ", $dp->as_string($slave_dsn), ": ", $EVAL_ERROR, "\n"
or die "Cannot print: $OS_ERROR";
return;
}
};
if ( $EVAL_ERROR ) {
print STDERR "Cannot connect to ", $dp->as_string($slave_dsn), "\n"
or die "Cannot print: $OS_ERROR";
return;
DBH: {
if ( !defined $dbh ) {
foreach my $known_slave ( @{$args->{slaves}} ) {
if ($known_slave->{dsn}->{h} eq $slave_dsn->{h} and
$known_slave->{dsn}->{P} eq $slave_dsn->{P} ) {
$dbh = $known_slave->{dbh};
last DBH;
}
}
$get_dbh->();
}
}
 
my $sql = 'SELECT @@SERVER_ID';
PTDEBUG && _d($sql);
my ($id) = $dbh->selectrow_array($sql);
my $id = undef;
do {
eval {
($id) = $dbh->selectrow_array($sql);
};
if ( $EVAL_ERROR ) {
if ( $args->{wait_no_die} ) {
print STDERR "Error getting server id: ", $EVAL_ERROR,
"\nRetrying query for server ", $slave_dsn->{h}, ":", $slave_dsn->{P}, "\n";
sleep 1;
$dbh->disconnect();
$get_dbh->();
} else {
die $EVAL_ERROR;
}
}
} until (defined $id);
PTDEBUG && _d('Working on server ID', $id);
my $master_thinks_i_am = $dsn->{server_id};
if ( !defined $id
......@@ -10636,7 +10742,13 @@ sub find_slave_hosts {
 
sub _find_slaves_by_processlist {
my ( $self, $dsn_parser, $dbh, $dsn ) = @_;
my @connected_slaves = $self->get_connected_slaves($dbh);
my @slaves = $self->_process_slaves_list($dsn_parser, $dsn, \@connected_slaves);
return @slaves;
}
 
sub _process_slaves_list {
my ($self, $dsn_parser, $dsn, $connected_slaves) = @_;
my @slaves = map {
my $slave = $dsn_parser->parse("h=$_", $dsn);
$slave->{source} = 'processlist';
......@@ -10644,12 +10756,15 @@ sub _find_slaves_by_processlist {
}
grep { $_ }
map {
my ( $host ) = $_->{host} =~ m/^([^:]+):/;
my ( $host ) = $_->{host} =~ m/^(.*):\d+$/;
if ( $host eq 'localhost' ) {
$host = '127.0.0.1'; # Replication never uses sockets.
}
if ($host =~ m/::/) {
$host = '['.$host.']';
}
$host;
} $self->get_connected_slaves($dbh);
} @$connected_slaves;
 
return @slaves;
}
......@@ -10668,8 +10783,8 @@ sub _find_slaves_by_hosts {
my %hash;
@hash{ map { lc $_ } keys %$_ } = values %$_;
my $spec = "h=$hash{host},P=$hash{port}"
. ( $hash{user} ? ",u=$hash{user}" : )
. ( $hash{password} ? ",p=$hash{password}" : );
. ( $hash{user} ? ",u=$hash{user}" : '')
. ( $hash{password} ? ",p=$hash{password}" : '');
my $dsn = $dsn_parser->parse($spec, $dsn);
$dsn->{server_id} = $hash{server_id};
$dsn->{master_id} = $hash{master_id};
......@@ -10788,13 +10903,20 @@ sub get_slave_status {
if (!$self->{channel}) {
die 'This server returned more than one row for SHOW SLAVE STATUS but "channel" was not specified on the command line';
}
my $slave_use_channels;
for my $row (@$sss_rows) {
$row = { map { lc($_) => $row->{$_} } keys %$row }; # lowercase the keys
if ($row->{channel_name}) {
$slave_use_channels = 1;
}
if ($row->{channel_name} eq $self->{channel}) {
$ss = $row;
last;
}
}
if (!$ss && $slave_use_channels) {
die 'This server is using replication channels but "channel" was not specified on the command line';
}
} else {
if ($sss_rows->[0]->{channel_name} && $sss_rows->[0]->{channel_name} ne $self->{channel}) {
die 'This server is using replication channels but "channel" was not specified on the command line';
......@@ -10807,6 +10929,9 @@ sub get_slave_status {
$ss = { map { lc($_) => $ss->{$_} } keys %$ss }; # lowercase the keys
return $ss;
}
if (!$ss && $self->{channel}) {
die "Specified channel name is invalid";
}
}
 
PTDEBUG && _d('This server returns nothing for SHOW SLAVE STATUS');
......@@ -10828,8 +10953,8 @@ sub get_master_status {
$sth->execute();
my ($ms) = @{$sth->fetchall_arrayref({})};
PTDEBUG && _d(
$ms ? map { "$_=" . (defined $ms->{$_} ? $ms->{$_} : ) } keys %$ms
: );
$ms ? map { "$_=" . (defined $ms->{$_} ? $ms->{$_} : '') } keys %$ms
: '');
 
if ( !$ms || scalar keys %$ms < 2 ) {
PTDEBUG && _d('Server on dbh', $dbh, 'does not seem to be a master');
......@@ -10863,7 +10988,7 @@ sub wait_for_master {
};
}
my $server_version = VersionParser->new($slave_dbh);
my $channel_sql = $server_version > '5.6' && $self->{channel} ? ", '$self->{channel}'" : ;
my $channel_sql = $server_version > '5.6' && $self->{channel} ? ", '$self->{channel}'" : '';
my $sql = "SELECT MASTER_POS_WAIT('$master_status->{file}', $master_status->{position}, $timeout $channel_sql)";
PTDEBUG && _d($slave_dbh, $sql);
my $start = time;
......@@ -11101,7 +11226,7 @@ sub is_replication_thread {
}
 
PTDEBUG && _d('Matches', $type, 'replication thread:',
($match ? 'yes' : no'), '; match:, $match);
($match ? 'yes' : 'no'), '; match:', $match);
 
return $match;
}
......@@ -11187,25 +11312,46 @@ sub get_cxn_from_dsn_table {
. "or a database-qualified table (t)";
}
 
my $done = 0;
my $dsn_tbl_cxn = $make_cxn->(dsn => $dsn);
my $dbh = $dsn_tbl_cxn->connect();
my $sql = "SELECT dsn FROM $dsn_table ORDER BY id";
PTDEBUG && _d($sql);
my $dsn_strings = $dbh->selectcol_arrayref($sql);
my @cxn;
if ( $dsn_strings ) {
foreach my $dsn_string ( @$dsn_strings ) {
PTDEBUG && _d('DSN from DSN table:', $dsn_string);
push @cxn, $make_cxn->(dsn_string => $dsn_string);
use Data::Dumper;
DSN:
do {
@cxn = ();
my $dsn_strings = $dbh->selectcol_arrayref($sql);
if ( $dsn_strings ) {
foreach my $dsn_string ( @$dsn_strings ) {
PTDEBUG && _d('DSN from DSN table:', $dsn_string);
if ($args{wait_no_die}) {
my $lcxn;
eval {
$lcxn = $make_cxn->(dsn_string => $dsn_string);
};
if ( $EVAL_ERROR && ($dsn_tbl_cxn->lost_connection($EVAL_ERROR)
|| $EVAL_ERROR =~ m/Can't connect to MySQL server/)) {
PTDEBUG && _d("Server is not accessible, waiting when it is online again");
sleep(1);
goto DSN;
}
push @cxn, $lcxn;
} else {
push @cxn, $make_cxn->(dsn_string => $dsn_string);
}
}
}
}
$done = 1;
} until $done;
return \@cxn;
}
 
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : undef }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
......@@ -11219,10 +11365,10 @@ sub _d {
# ###########################################################################
# Progress package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/Progress.pm
# t/lib/Progress.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package Progress;
......@@ -11352,7 +11498,7 @@ sub fraction_modulo {
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : undef }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
......@@ -11366,10 +11512,10 @@ sub _d {
# ###########################################################################
# FileIterator package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/FileIterator.pm
# t/lib/FileIterator.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package FileIterator;
......@@ -11431,7 +11577,7 @@ sub get_file_itr {
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : undef }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
......@@ -11445,10 +11591,10 @@ sub _d {
# ###########################################################################
# Runtime package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/Runtime.pm
# t/lib/Runtime.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package Runtime;
......@@ -11564,7 +11710,7 @@ sub start {
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : undef }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
......@@ -11578,10 +11724,10 @@ sub _d {
# ###########################################################################
# Pipeline package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/Pipeline.pm
# t/lib/Pipeline.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package Pipeline;
......@@ -11748,7 +11894,7 @@ sub reset {
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : undef }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
......@@ -11762,10 +11908,10 @@ sub _d {
# ###########################################################################
# HTTP::Micro package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/HTTP/Micro.pm
# t/lib/HTTP/Micro.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package HTTP::Micro;
......@@ -11896,12 +12042,12 @@ sub _split_url {
my $url = pop;
 
my ($scheme, $authority, $path_query) = $url =~ m<\A([^:/?#]+)://([^/?#]*)([^#]*)>
or Carp::croak(qq/Cannot parse URL: $url/);
or Carp::croak(qq/Cannot parse URL: '$url'/);
 
$scheme = lc $scheme;
$path_query = "/$path_query" unless $path_query =~ m<\A/>;
 
my $host = (length($authority)) ? lc $authority : localhost;
my $host = (length($authority)) ? lc $authority : 'localhost';
$host =~ s/\A[^@]*@//; # userinfo
my $port = do {
$host =~ s/:([0-9]*)\z// && length $1
......@@ -11975,7 +12121,7 @@ sub _split_url {
) or croak(qq/Could not connect to '$host:$port': $@/);
 
binmode($self->{fh})
or croak(qq/Could not binmode() socket: $!/);
or croak(qq/Could not binmode() socket: '$!'/);
 
if ( $scheme eq 'https') {
IO::Socket::SSL->start_SSL($self->{fh});
......@@ -12002,7 +12148,7 @@ sub _split_url {
@_ == 1 || croak(q/Usage: $handle->close()/);
my ($self) = @_;
CORE::close($self->{fh})
or croak(qq/Could not close socket: $!/);
or croak(qq/Could not close socket: '$!'/);
}
 
sub write {
......@@ -12027,7 +12173,7 @@ sub _split_url {
croak(qq/Socket closed by remote server: $!/);
}
elsif ($! != EINTR) {
croak(qq/Could not write to socket: $!/);
croak(qq/Could not write to socket: '$!'/);
}
}
return $off;
......@@ -12055,7 +12201,7 @@ sub _split_url {
$len -= $r;
}
elsif ($! != EINTR) {
croak(qq/Could not read from socket: $!/);
croak(qq/Could not read from socket: '$!'/);
}
}
if ($len) {
......@@ -12079,7 +12225,7 @@ sub _split_url {
last unless $r;
}
elsif ($! != EINTR) {
croak(qq/Could not read from socket: $!/);
croak(qq/Could not read from socket: '$!'/);
}
}
croak(q/Unexpected end of stream while looking for line/);
......@@ -12157,7 +12303,7 @@ sub _split_url {
$len += $self->write($request->{content});
 
$len == $content_length
or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/);
or croak(qq/Content-Length mismatch (got: $len expected: $content_length)/);
 
return $len;
}
......@@ -12196,7 +12342,7 @@ sub _split_url {
 
my $fd = fileno $self->{fh};
defined $fd && $fd >= 0
or croak(q/select(2): Bad file descriptor/);
or croak(q/select(2): 'Bad file descriptor'/);
 
my $initial = time;
my $pending = $timeout;
......@@ -12210,7 +12356,7 @@ sub _split_url {
: select(undef, $fdset, undef, $pending) ;
if ($nfound == -1) {
$! == EINTR
or croak(qq/select(2): $!/);
or croak(qq/select(2): '$!'/);
redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
$nfound = 0;
}
......@@ -12415,10 +12561,10 @@ if ( $INC{"IO/Socket/SSL.pm"} ) {
# ###########################################################################
# VersionCheck package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/VersionCheck.pm
# t/lib/VersionCheck.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package VersionCheck;
......@@ -12446,15 +12592,16 @@ eval {
require HTTP::Micro;
};
 
my $home = $ENV{HOME} || $ENV{HOMEPATH} || $ENV{USERPROFILE} || '.';
my @vc_dirs = (
'/etc/percona',
'/etc/percona-toolkit',
'/tmp',
"$home",
);
{
my $file = 'percona-version-check';
my $home = $ENV{HOME} || $ENV{HOMEPATH} || $ENV{USERPROFILE} || '.';
my @vc_dirs = (
'/etc/percona',
'/etc/percona-toolkit',
'/tmp',
"$home",
);
 
sub version_check_file {
foreach my $dir ( @vc_dirs ) {
......@@ -12518,13 +12665,15 @@ sub version_check {
return;
}
PTDEBUG && _d('Using', $protocol);
my $url = $args{url} # testing
|| $ENV{PERCONA_VERSION_CHECK_URL} # testing
|| "$protocol://v.percona.com";
PTDEBUG && _d('API URL:', $url);
 
my $advice = pingback(
instances => $instances_to_check,
protocol => $protocol,
url => $args{url} # testing
|| $ENV{PERCONA_VERSION_CHECK_URL} # testing
|| "$protocol://v.percona.com",
url => $url,
);
if ( $advice ) {
PTDEBUG && _d('Advice:', Dumper($advice));
......@@ -12587,7 +12736,7 @@ sub get_instances_to_check {
my @instances_to_check;
foreach my $instance ( @$instances ) {
my $last_check_time = $last_check_time_for{ $instance->{id} };
PTDEBUG && _d('Intsance', $instance->{id}, 'last checked',
PTDEBUG && _d('Instance', $instance->{id}, 'last checked',
$last_check_time, 'now', $now, 'diff', $now - ($last_check_time || 0),
'hours until next check',
sprintf '%.2f',
......@@ -12671,11 +12820,56 @@ sub get_instance_id {
}
 
 
sub get_uuid {
my $uuid_file = '/.percona-toolkit.uuid';
foreach my $dir (@vc_dirs) {
my $filename = $dir.$uuid_file;
my $uuid=_read_uuid($filename);
return $uuid if $uuid;
}
my $filename = $ENV{"HOME"} . $uuid_file;
my $uuid = _generate_uuid();
my $fh;
eval {
open($fh, '>', $filename);
};
if (!$EVAL_ERROR) {
print $fh $uuid;
close $fh;
}
return $uuid;
}
sub _generate_uuid {
return sprintf+($}="%04x")."$}-$}-$}-$}-".$}x3,map rand 65537,0..7;
}
sub _read_uuid {
my $filename = shift;
my $fh;
eval {
open($fh, '<:encoding(UTF-8)', $filename);
};
return if ($EVAL_ERROR);
my $uuid;
eval { $uuid = <$fh>; };
return if ($EVAL_ERROR);
chomp $uuid;
return $uuid;
}
sub pingback {
my (%args) = @_;
my @required_args = qw(url instances);
foreach my $arg ( @required_args ) {
die "I need a $arg arugment" unless $args{$arg};
die "I need a $arg argument" unless $args{$arg};
}
my $url = $args{url};
my $instances = $args{instances};
......@@ -12707,11 +12901,12 @@ sub pingback {
my $client_content = encode_client_response(
items => $items,
versions => $versions,
general_id => md5_hex( hostname() ),
general_id => get_uuid(),
);
 
my $tool_name = $ENV{XTRABACKUP_VERSION} ? "Percona XtraBackup" : File::Basename::basename($0);
my $client_response = {
headers => { "X-Percona-Toolkit-Tool" => File::Basename::basename($0) },
headers => { "X-Percona-Toolkit-Tool" => $tool_name },
content => $client_content,
};
PTDEBUG && _d('Client response:', Dumper($client_response));
......@@ -12742,7 +12937,7 @@ sub encode_client_response {
my (%args) = @_;
my @required_args = qw(items versions general_id);
foreach my $arg ( @required_args ) {
die "I need a $arg arugment" unless $args{$arg};
die "I need a $arg argument" unless $args{$arg};
}
my ($items, $versions, $general_id) = @args{@required_args};
 
......@@ -12768,7 +12963,7 @@ sub parse_server_response {
my (%args) = @_;
my @required_args = qw(response);
foreach my $arg ( @required_args ) {
die "I need a $arg arugment" unless $args{$arg};
die "I need a $arg argument" unless $args{$arg};
}
my ($response) = @args{@required_args};
 
......@@ -12794,6 +12989,7 @@ my %sub_for_type = (
perl_version => \&get_perl_version,
perl_module_version => \&get_perl_module_version,
mysql_variable => \&get_mysql_variable,
xtrabackup => \&get_xtrabackup_version,
);
 
sub valid_item {
......@@ -12810,7 +13006,7 @@ sub get_versions {
my (%args) = @_;
my @required_args = qw(items);
foreach my $arg ( @required_args ) {
die "I need a $arg arugment" unless $args{$arg};
die "I need a $arg argument" unless $args{$arg};
}
my ($items) = @args{@required_args};
 
......@@ -12921,6 +13117,10 @@ sub get_perl_version {
return $version;
}
 
sub get_xtrabackup_version {
return $ENV{XTRABACKUP_VERSION};
}
sub get_perl_module_version {
my (%args) = @_;
my $item = $args{item};
......@@ -12984,7 +13184,7 @@ sub get_from_mysql {
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : undef }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
......@@ -13167,6 +13367,9 @@ sub main {
DSNParser => $dp,
opts => { AutoCommit => 1 },
);
if ($EVAL_ERROR) {
die ("Cannot connect to the explain database: $EVAL_ERROR")
}
$ep_dbh->{InactiveDestroy} = 1; # Don't die on fork().
}
 
......@@ -13189,6 +13392,10 @@ sub main {
DSNParser => $dp,
opts => { AutoCommit => 1 },
);
if ($EVAL_ERROR) {
die ("Cannot connect to the review database: $EVAL_ERROR")
}
$qv_dbh->{InactiveDestroy} = 1; # Don't die on fork().
 
my @db_tbl = @{$review_dsn}{qw(D t)};
......@@ -13233,6 +13440,9 @@ sub main {
DSNParser => $dp,
opts => { AutoCommit => 1 },
);
if ($EVAL_ERROR) {
die ("Cannot connect to the history database: $EVAL_ERROR")
}
$qh_dbh->{InactiveDestroy} = 1; # Don't die on fork().
 
my @hdb_tbl = @{$history_dsn}{qw(D t)};
......@@ -13279,7 +13489,7 @@ sub main {
my %stats; # various stats/counters used in some procs
 
# The pipeline data hashref is passed to each proc. Procs use this to
# pass data through the pipeline. The most importat data is the event.
# pass data through the pipeline. The most important data is the event.
# Other data includes in the next_event callback, time and iters left,
# etc. This hashref is accessed inside a proc via the $args arg.
my $pipeline_data = {
......@@ -13346,7 +13556,7 @@ sub main {
}
PTDEBUG && _d('Reading', $filename);
PTDEBUG && _d('File size:', $filesize);
# catch if user is trying to use an uncoverted (raw) binlog # issue 1377888
# catch if user is trying to use an unconverted (raw) binlog # issue 1377888
if ( $filename && $o->get('type')->[0] eq 'binlog') {
if (is_raw_binlog($filename)) {
warn "Binlog file $filename must first be converted to text format using mysqlbinlog";
......@@ -14171,13 +14381,14 @@ sub main {
 
if ( $o->get('output') =~ /slowlog/i ) {
my $w = new SlowLogWriter();
my $field = $o->get('output') eq 'secure-slowlog' ? 'fingerprint' : '';
$pipeline->add(
name => '--output slowlog',
process => sub {
my ( $args ) = @_;
my $event = $args->{event};
PTDEBUG && _d('callback: --output slowlog');
$w->write(*STDOUT, $event);
$w->write(*STDOUT, $event, $field);
return $args;
},
);
......@@ -14381,7 +14592,7 @@ sub create_review_tables {
tbl => $tbl,
);
 
PTDEBUG && _d('Table exists: , $tbl_exists ? 'yes' : 'no);
PTDEBUG && _d('Table exists: ', $tbl_exists ? 'yes' : 'no');
 
if ( !$tbl_exists && !$args{create_table} ) {
die "Table $full_table does not exist and "
......@@ -14462,15 +14673,17 @@ sub print_reports {
 
my $report_class = $o->get('output') =~ m/^json/i
? 'JSONReportFormatter'
: QueryReportFormatter;
: 'QueryReportFormatter';
my $qrf = $report_class->new(
dbh => $ep_dbh,
QueryReview => $args{QueryReview},
QueryRewriter => $args{QueryRewriter},
OptionParser => $args{OptionParser},
QueryParser => $args{QueryParser},
Quoter => $args{Quoter},
show_all => $show_all,
dbh => $ep_dbh,
QueryReview => $args{QueryReview},
QueryRewriter => $args{QueryRewriter},
OptionParser => $args{OptionParser},
QueryParser => $args{QueryParser},
Quoter => $args{Quoter},
show_all => $show_all,
max_hostname_length => $o->get('max-hostname-length'),
max_line_length => $o->get('max-line-length'),
);
 
$qrf->print_reports(
......@@ -14906,7 +15119,7 @@ sub is_raw_binlog {
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : undef }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
......@@ -14947,7 +15160,7 @@ Report the slowest queries from the processlist on host1:
 
pt-query-digest --processlist h=host1
 
Capture MySQL protocol data with tcppdump, then report the slowest queries:
Capture MySQL protocol data with tcpdump, then report the slowest queries:
 
tcpdump -s 65535 -x -nn -q -tttt -i any -c 1000 port 3306 > mysql.tcp.txt
 
......@@ -15053,7 +15266,7 @@ The information is very similar to what you'll see for each class of queries in
the log, but it doesn't have some information that would be too expensive to
keep globally for the analysis. It also has some statistics about the code's
execution itself, such as the CPU and memory usage, the local date and time
of the run, and a list of input file read/parsed.
of the run, and a list of input files read/parsed.
 
Following this is the response-time profile over the events. This is a
highly summarized view of the unique events in the detailed query report
......@@ -15360,7 +15573,7 @@ Prompt for a password when connecting to MySQL.
 
type: array; default: db|Schema
 
List of attribute|alias,etc.
List of attribute|alias, etc.
 
Certain attributes have multiple names, like db and Schema. If an event does
not have the primary attribute, pt-query-digest looks for an alias attribute.
......@@ -15522,7 +15735,7 @@ The subroutine template is:
 
sub { $event = shift; filter && return $event; }
 
Filters given on the command line are wrapped inside parentheses like like
Filters given on the command line are wrapped inside parentheses like
C<( filter )>. For complex, multi-line filters, you must put the code inside
a file so it will not be wrapped inside parentheses. Either way, the filter
must produce syntactically valid code given the template. For example, an
......@@ -15663,7 +15876,7 @@ pt-query-digest inspects the columns in the table. The table must have at
least the following columns:
 
CREATE TABLE query_review_history (
checksum BIGINT UNSIGNED NOT NULL,
checksum CHAR(32) NOT NULL,
sample TEXT NOT NULL
);
 
......@@ -15693,7 +15906,7 @@ The following table definition is used for L<"--[no]create-history-table">:
MAGIC_create_history_table
 
CREATE TABLE IF NOT EXISTS query_history (
checksum BIGINT UNSIGNED NOT NULL,
checksum CHAR(32) NOT NULL,
sample TEXT NOT NULL,
ts_min DATETIME,
ts_max DATETIME,
......@@ -15797,6 +16010,9 @@ MAGIC_create_history_table
Note that we store the count (cnt) for the ts attribute only; it will be
redundant to store this for other attributes.
 
Starting from Percona Toolkit 3.0.11, the checksum function has been updated to use 32 chars in the MD5 sum.
This causes the checksum field in the history table to have a different value than in the previous versions of the tool.
=item --host
 
short form: -h; type: string
......@@ -15863,6 +16079,18 @@ type: string
 
Print all output to this file when daemonized.
 
=item --max-hostname-length
type: int; default: 10
Trim host names in reports to this length. 0=Do not trim host names.
=item --max-line-length
type: int; default: 74
Trim lines to this length. 0=Do not trim lines.
=item --order-by
 
type: Array; default: Query_time:sum
......@@ -15887,7 +16115,7 @@ For example, the default C<Query_time:sum> means that queries in the
query analysis report will be ordered (sorted) by their total query execution
time ("Exec time"). C<Query_time:max> orders the queries by their
maximum query execution time, so the query with the single largest
C<Query_time> will be list first. C<cnt> refers more to the frequency
C<Query_time> will be listed first. C<cnt> refers more to the frequency
of the query as a whole, how often it appears; "Count" is its corresponding
line in the query analysis report. So any attribute and C<cnt> should yield
the same report wherein queries are sorted by the number of times they
......@@ -15928,12 +16156,13 @@ type: string; default: report
 
How to format and print the query analysis results. Accepted values are:
 
VALUE FORMAT
======= ==============================
report Standard query analysis report
slowlog MySQL slow log
json JSON, on array per query class
json-anon JSON without example queries
VALUE FORMAT
======= ===============================
report Standard query analysis report
slowlog MySQL slow log
json JSON, one array per query class
json-anon JSON without example queries
secure-slowlog JSON without example queries
 
The entire C<report> output can be disabled by specifying C<--no-report>
(see L<"--[no]report">), and its sections can be disabled or rearranged
......@@ -15968,8 +16197,8 @@ Port number to use for connection.
=item --preserve-embedded-numbers
 
Preserve numbers in database/table names when fingerprinting queries.
The standar fingeprint method replaces numbers in db/tables names, making
a query like 'SELECT * FROM db1.table2' to be figerprinted as 'SELECT * FROM db?.table?'.
The standard fingerprint method replaces numbers in db/tables names, making
a query like 'SELECT * FROM db1.table2' to be fingerprinted as 'SELECT * FROM db?.table?'.
This option changes that behaviour and the fingerprint will become
'SELECT * FROM db1.table2'.
 
......@@ -16033,7 +16262,7 @@ Print these sections of the query analysis report.
rusage CPU times and memory usage reported by ps
date Current local date and time
hostname Hostname of machine on which pt-query-digest was run
files Input files read/parse
files Input files read/parsed
header Summary of the entire analysis run
profile Compact table of queries for an overview of the report
query_report Detailed information about each unique query
......@@ -16098,7 +16327,7 @@ by pt-query-digest.
MAGIC_create_review_table:
 
CREATE TABLE IF NOT EXISTS query_review (
checksum BIGINT UNSIGNED NOT NULL PRIMARY KEY,
checksum CHAR(32) NOT NULL PRIMARY KEY,
fingerprint TEXT NOT NULL,
sample TEXT NOT NULL,
first_seen DATETIME,
......@@ -16245,7 +16474,7 @@ MAGIC_set_vars
wait_timeout=10000
 
Variables specified on the command line override these defaults. For
example, specifying C<--set-vars wait_timeout=500> overrides the defaultvalue of C<10000>.
example, specifying C<--set-vars wait_timeout=500> overrides the default value of C<10000>.
 
The tool prints a warning and continues if a variable cannot be set.
 
......@@ -16255,7 +16484,7 @@ type: Hash
 
Show all values for these attributes.
 
By default pt-query-digest only shows as many of an attribute's value that
By default pt-query-digest only shows as many of an attribute's value as
fit on a single line. This option allows you to specify attributes for which
all values will be shown (line width is ignored). This only works for
attributes with string values like user, host, db, etc. Multiple attributes
......@@ -16291,7 +16520,7 @@ The MySQL time expression is wrapped inside a query like
valid inside this query. For example, do not use UNIX_TIMESTAMP() because
UNIX_TIMESTAMP(UNIX_TIMESTAMP()) returns 0.
 
Events are assumed to be in chronological: older events at the beginning of
Events are assumed to be in chronological order: older events at the beginning of
the log and newer events at the end of the log. L<"--since"> is strict: it
ignores all queries until one is found that is new enough. Therefore, if
the query events are not consistently timestamped, some may be ignored which
......@@ -16312,7 +16541,7 @@ Show a timeline of events.
This option makes pt-query-digest print another kind of report: a timeline of
the events. Each query is still grouped and aggregate into classes according to
L<"--group-by">, but then they are printed in chronological order. The timeline
report prints out the timestamp, interval, count and value of each classes.
report prints out the timestamp, interval, count and value of each class.
 
If all you want is the timeline report, then specify C<--no-report> to
suppress the default query analysis report. Otherwise, the timeline report
......@@ -16404,7 +16633,7 @@ queries. (See L<http://www.mysqlperformanceblog.com/?p=6092> for details.)
'port 3306 and tcp[1] & 7 == 2 and tcp[3] & 7 == 2'
 
All MySQL servers running on port 3306 are automatically detected in the
tcpdump output. Therefore, if the tcpdump out contains packets from
tcpdump output. Therefore, if the tcpdump output contains packets from
multiple servers on port 3306 (for example, 10.0.0.1:3306, 10.0.0.2:3306,
etc.), all packets/queries from all these servers will be analyzed
together as if they were one server.
......@@ -16494,18 +16723,24 @@ default: yes
Check for the latest version of Percona Toolkit, MySQL, and other programs.
 
This is a standard "check for updates automatically" feature, with two
additional features. First, the tool checks the version of other programs
on the local system in addition to its own version. For example, it checks
the version of every MySQL server it connects to, Perl, and the Perl module
DBD::mysql. Second, it checks for and warns about versions with known
problems. For example, MySQL 5.5.25 had a critical bug and was re-released
additional features. First, the tool checks its own version and also the
versions of the following software: operating system, Percona Monitoring and
Management (PMM), MySQL, Perl, MySQL driver for Perl (DBD::mysql), and
Percona Toolkit. Second, it checks for and warns about versions with known
problems. For example, MySQL 5.5.25 had a critical bug and was re-released
as 5.5.25a.
 
A secure connection to Percona’s Version Check database server is done to
perform these checks. Each request is logged by the server, including software
version numbers and unique ID of the checked system. The ID is generated by the
Percona Toolkit installation script or when the Version Check database call is
done for the first time.
Any updates or known problems are printed to STDOUT before the tool's normal
output. This feature should never interfere with the normal operation of the
tool.
 
For more information, visit L<https://www.percona.com/version-check>.
For more information, visit L<https://www.percona.com/doc/percona-toolkit/LATEST/version-check.html>.
 
=item --[no]vertical-format
 
......@@ -16610,6 +16845,11 @@ To enable debugging and capture all output to a file, run the tool like:
Be careful: debugging output is voluminous and can generate several megabytes
of output.
 
=head1 ATTENTION
Using <PTDEBUG> might expose passwords. When debug is enabled, all command line
parameters are shown in the output.
=head1 SYSTEM REQUIREMENTS
 
You need Perl, DBI, DBD::mysql, and some core packages that ought to be
......@@ -16617,9 +16857,9 @@ installed in any reasonably new version of Perl.
 
=head1 BUGS
 
For a list of known bugs, see L<http://www.percona.com/bugs/pt-query-digest>.
For a list of known bugs, see L<https://jira.percona.com/projects/PT/issues>.
 
Please report bugs at L<https://bugs.launchpad.net/percona-toolkit>.
Please report bugs at L<https://jira.percona.com/projects/PT>.
Include the following information in your bug report:
 
=over
......@@ -16801,7 +17041,7 @@ software from Percona.
 
=head1 COPYRIGHT, LICENSE, AND WARRANTY
 
This program is copyright 2008-2017 Percona LLC and/or its affiliates.
This program is copyright 2008-2018 Percona LLC and/or its affiliates.
 
THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
......@@ -16819,6 +17059,6 @@ Place, Suite 330, Boston, MA 02111-1307 USA.
 
=head1 VERSION
 
pt-query-digest 3.0.6
pt-query-digest 3.5.7
 
=cut