PT-2140 - Update modules in the main branch (#570)

* PT-2140 - Update modules in the main branch

Updated modules for:
- pt-align
- pt-archiver
- pt-config-diff
- pt-deadlock-logger
- pt-diskstats
- pt-duplicate-key-checker
- pt-fifo-split
- pt-find
- pt-fingerprint
- pt-fk-error-logger
- pt-heartbeat
- pt-index-usage
- pt-ioprofile
- pt-kill
- pt-mext
- pt-mysql-summary
- pt-online-schema-change
- pt-pmp
- pt-query-digest
- pt-show-grants
- pt-sift
- pt-slave-delay
- pt-slave-find
- pt-slave-restart
- pt-summary
- pt-table-sync
- pt-upgrade
- pt-variable-advisor

Added execute bit for pt-query-digest

* PT-2140 Update modules in the main branch

Fixed Daemon.pm plugin usage
Updated all tests, related to the Daemon plugin.
I intentionally did not fix failing tests, not related to Daemon plugin,
to avoid making this PR too big.

- bin/pt-archiver
	- PT-2141 - Fixed usage of Daemon.pm
	- PT-2141 - Updated t/pt-archiver/standard_options.t
- bin/pt-deadlock-logger
	- PT-2143 - Fixed usage of Daemon.pm
	- PT-2143 - Updated t/pt-deadlock-logger/standard_options.t
- bin/pt-fifo-split
	- PT-2144 - Fixed usage of Daemon.pm
	- PT-2144 - Updated t/pt-fifo-split/pt-fifo-split.t
- bin/pt-find
	- PT-2145 - Fixed usage of Daemon.pm
	- PT-2145 - Updated t/pt-find/pt-find.t
- bin/pt-fk-error-logger
	- PT-2146 - Fixed usage of Daemon.pm
	- PT-2146 - Updated t/pt-fk-error-logger/basics.t
- bin/pt-heartbeat
	- PT-2147 - Fixed usage of Daemon.pm
	- PT-2147 - Updated t/pt-heartbeat/standard_options.t, t/pt-heartbeat/basics.t
- bin/pt-kill
	- PT-2148 - Fixed usage of Daemon.pm
	- PT-2148 - Updated t/pt-kill/standard_options.t
- bin/pt-show-grants
	- PT-2152 - Fixed usage of Daemon.pm
	- PT-2152 - Updated t/pt-show-grants/standard_options.t
- bin/pt-slave-delay
	- Fixed usage of Daemon.pm
	- Updated t/pt-slave-delay/standard_options.t
- bin/pt-slave-find
	- PT-2153 - Fixed usage of Daemon.pm
	- PT-2153 -Updated t/pt-slave-find/pt-slave-find.t
- bin/pt-slave-restart
	- Fixed usage of Daemon.pm
	- Updated t/pt-slave-restart/pt-slave-restart.t
- bin/pt-table-sync
	- PT-2154 - Fixed usage of Daemon.pm
	- PT-2154 -Updated t/pt-table-sync/standard_options.t
This commit is contained in:
Sveta Smirnova
2023-01-06 15:04:10 +03:00
committed by GitHub
parent a3283d65ad
commit 2f584c85db
41 changed files with 4408 additions and 3368 deletions

View File

@@ -94,10 +94,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;
@@ -152,7 +152,7 @@ sub split_unquote {
s/`\z//;
s/``/`/g;
}
return ($db, $tbl);
}
@@ -247,10 +247,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;
@@ -406,9 +406,9 @@ 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;
}
@@ -680,10 +680,10 @@ sub _d {
# ###########################################################################
# 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;
@@ -767,7 +767,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};
@@ -907,7 +907,7 @@ sub get_dbh {
my $dbh;
my $tries = 2;
while ( !$dbh && $tries-- ) {
PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
$dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) };
@@ -1105,7 +1105,7 @@ sub set_vars {
}
}
return;
return;
}
sub _d {
@@ -1125,10 +1125,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;
@@ -1186,7 +1186,7 @@ sub new {
rules => [], # desc of rules for --help
mutex => [], # rule: opts are mutually exclusive
atleast1 => [], # rule: at least one opt is required
disables => {}, # rule: opt disables other opts
disables => {}, # rule: opt disables other opts
defaults_to => {}, # rule: opt defaults to value of other opt
DSNParser => undef,
default_files => [
@@ -1349,7 +1349,7 @@ sub _pod_to_specs {
}
push @specs, {
spec => $self->{parse_attributes}->($self, $option, \%attribs),
spec => $self->{parse_attributes}->($self, $option, \%attribs),
desc => $para
. (defined $attribs{default} ? " (default $attribs{default})" : ''),
group => ($attribs{'group'} ? $attribs{'group'} : 'default'),
@@ -1440,7 +1440,7 @@ sub _parse_specs {
$self->{opts}->{$long} = $opt;
}
else { # It's an option rule, not a spec.
PTDEBUG && _d('Parsing rule:', $opt);
PTDEBUG && _d('Parsing rule:', $opt);
push @{$self->{rules}}, $opt;
my @participants = $self->_get_participants($opt);
my $rule_ok = 0;
@@ -1485,7 +1485,7 @@ sub _parse_specs {
PTDEBUG && _d('Option', $long, 'disables', @participants);
}
return;
return;
}
sub _get_participants {
@@ -1572,7 +1572,7 @@ sub _set_option {
}
sub get_opts {
my ( $self ) = @_;
my ( $self ) = @_;
foreach my $long ( keys %{$self->{opts}} ) {
$self->{opts}->{$long}->{got} = 0;
@@ -1703,7 +1703,7 @@ sub _check_opts {
else {
$err = join(', ',
map { "--$self->{opts}->{$_}->{long}" }
grep { $_ }
grep { $_ }
@restricted_opts[0..scalar(@restricted_opts) - 2]
)
. ' or --'.$self->{opts}->{$restricted_opts[-1]}->{long};
@@ -1713,7 +1713,7 @@ sub _check_opts {
}
}
elsif ( $opt->{is_required} ) {
elsif ( $opt->{is_required} ) {
$self->save_error("Required option --$long must be specified");
}
@@ -2097,7 +2097,7 @@ sub clone {
$clone{$scalar} = $self->{$scalar};
}
return bless \%clone;
return bless \%clone;
}
sub _parse_size {
@@ -2236,10 +2236,10 @@ if ( PTDEBUG ) {
# ###########################################################################
# KeySize 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/KeySize.pm
# t/lib/KeySize.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package KeySize;
@@ -2386,10 +2386,10 @@ sub _d {
# ###########################################################################
# DuplicateKeyFinder 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/DuplicateKeyFinder.pm
# t/lib/DuplicateKeyFinder.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package DuplicateKeyFinder;
@@ -2434,7 +2434,7 @@ sub get_duplicate_keys {
if ( $args{ignore_order} || $is_fulltext ) {
my $ordered_cols = join(',', sort(split(/,/, $key->{colnames})));
PTDEBUG && _d('Reordered', $key->{name}, 'cols from',
$key->{colnames}, 'to', $ordered_cols);
$key->{colnames}, 'to', $ordered_cols);
$key->{colnames} = $ordered_cols;
}
@@ -2442,7 +2442,7 @@ sub get_duplicate_keys {
if ( !$args{ignore_structure} ) {
$push_to = \@fulltext_keys if $is_fulltext;
}
push @$push_to, $key;
push @$push_to, $key;
}
push @normal_keys, $self->unconstrain_keys($primary_key, \@unique_keys);
@@ -2565,7 +2565,7 @@ sub remove_prefix_duplicates {
@$left_keys = reverse sort { lc($a->{colnames}) cmp lc($b->{colnames}) }
grep { defined $_; }
@$left_keys;
$last_left_key = scalar(@$left_keys) - 2;
$right_offset = 1;
@@ -2609,7 +2609,7 @@ sub remove_prefix_duplicates {
if ( my $type = $right_keys->[$right_index]->{unconstrained} ) {
$reason .= "Uniqueness of $right_name ignored because "
. $right_keys->[$right_index]->{constraining_key}->{name}
. " is a $type constraint\n";
. " is a $type constraint\n";
}
my $exact_dupe = $right_len_cols < $left_len_cols ? 0 : 1;
$reason .= $right_name
@@ -2790,10 +2790,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;
@@ -2851,7 +2851,7 @@ sub run {
$parent_exit->($child_pid) if $parent_exit;
exit 0;
}
POSIX::setsid() or die "Cannot start a new session: $OS_ERROR";
chdir '/' or die "Cannot chdir to /: $OS_ERROR";
@@ -2877,7 +2877,7 @@ sub run {
close STDERR;
open STDERR, ">&STDOUT"
or die "Cannot dupe STDERR to STDOUT: $OS_ERROR";
or die "Cannot dupe STDERR to STDOUT: $OS_ERROR";
}
else {
if ( -t STDOUT ) {
@@ -2915,7 +2915,7 @@ sub _make_pid_file {
eval {
sysopen(PID_FH, $pid_file, O_RDWR|O_CREAT|O_EXCL) or die $OS_ERROR;
print PID_FH $PID, "\n";
close PID_FH;
close PID_FH;
};
if ( my $e = $EVAL_ERROR ) {
if ( $e =~ m/file exists/i ) {
@@ -3044,10 +3044,10 @@ sub _d {
# ###########################################################################
# Schema 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/Schema.pm
# t/lib/Schema.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package Schema;
@@ -3169,7 +3169,9 @@ sub find_column {
}
}
@tbls = sort {$b->{name} cmp $a->{name}} @tbls;
return \@tbls;
}
sub find_table {
@@ -3220,6 +3222,7 @@ sub find_table {
}
}
@dbs = sort @dbs;
return \@dbs;
}
@@ -3718,10 +3721,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;
@@ -3947,7 +3950,7 @@ sub _split_url {
or die(qq/SSL certificate not valid for $host\n/);
}
}
$self->{host} = $host;
$self->{port} = $port;
@@ -4371,10 +4374,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;
@@ -4422,7 +4425,7 @@ my @vc_dirs = (
}
PTDEBUG && _d('Version check file', $file, 'in', $ENV{PWD});
return $file; # in the CWD
}
}
}
sub version_check_time_limit {
@@ -4439,11 +4442,11 @@ sub version_check {
PTDEBUG && _d('FindBin::Bin:', $FindBin::Bin);
if ( !$args{force} ) {
if ( $FindBin::Bin
&& (-d "$FindBin::Bin/../.bzr" ||
&& (-d "$FindBin::Bin/../.bzr" ||
-d "$FindBin::Bin/../../.bzr" ||
-d "$FindBin::Bin/../.git" ||
-d "$FindBin::Bin/../../.git"
)
-d "$FindBin::Bin/../.git" ||
-d "$FindBin::Bin/../../.git"
)
) {
PTDEBUG && _d("$FindBin::Bin/../.bzr disables --version-check");
return;
@@ -4467,7 +4470,7 @@ sub version_check {
PTDEBUG && _d(scalar @$instances_to_check, 'instances to check');
return unless @$instances_to_check;
my $protocol = 'https';
my $protocol = 'https';
eval { require IO::Socket::SSL; };
if ( $EVAL_ERROR ) {
PTDEBUG && _d($EVAL_ERROR);
@@ -4475,13 +4478,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));
@@ -4639,12 +4644,17 @@ sub get_uuid {
my $filename = $ENV{"HOME"} . $uuid_file;
my $uuid = _generate_uuid();
open(my $fh, '>', $filename) or die "Could not open file '$filename' $!";
print $fh $uuid;
close $fh;
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;
@@ -4693,7 +4703,7 @@ sub pingback {
);
die "Failed to parse server requested programs: $response->{content}"
if !scalar keys %$items;
my $versions = get_versions(
items => $items,
instances => $instances,
@@ -4707,8 +4717,9 @@ sub pingback {
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));
@@ -4791,6 +4802,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 {
@@ -4918,6 +4930,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};
@@ -4952,7 +4968,7 @@ sub get_from_mysql {
if ($item->{item} eq 'MySQL' && $item->{type} eq 'mysql_variable') {
@{$item->{vars}} = grep { $_ eq 'version' || $_ eq 'version_comment' } @{$item->{vars}};
}
my @versions;
my %version_for;