percona/percona-toolkit
1
0
Fork 0
mirror of https://github.com/percona/percona-toolkit.git synced 2025-09-15 07:55:51 +00:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
* 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
Download Patch File Download Diff File Expand all files Collapse all files

486
bin/pt-config-diff
View File

@@ -98,10 +98,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;
@@ -158,10 +158,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;
@@ -215,10 +215,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;
@@ -311,10 +311,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;
@@ -412,10 +412,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 {
@@ -473,7 +473,7 @@ sub extends {
sub _load_module {
my ($class) = @_;
(my $file = $class) =~ s{::|'}{/}g;
$file .= '.pm';
{ local $@; eval { require "$file" } } # or warn $@;
@@ -504,7 +504,7 @@ sub has {
my $caller = scalar caller();
my $class_metadata = Lmo::Meta->metadata_for($caller);
for my $attribute ( ref $names ? @$names : $names ) {
my %args = @_;
my $method = ($args{is} || '') eq 'ro'
@@ -523,16 +523,16 @@ sub has {
if ( my $type_check = $args{isa} ) {
my $check_name = $type_check;
if ( my ($aggregate_type, $inner_type) = $type_check =~ /\A(ArrayRef|Maybe)\[(.*)\]\z/ ) {
$type_check = Lmo::Types::_nested_constraints($attribute, $aggregate_type, $inner_type);
}
my $check_sub = sub {
my ($new_val) = @_;
Lmo::Types::check_type_constaints($attribute, $type_check, $check_name, $new_val);
};
$class_metadata->{$attribute}{isa} = [$check_name, $check_sub];
my $orig_method = $method;
$method = sub {
@@ -747,10 +747,10 @@ sub override {
# ###########################################################################
# 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;
@@ -808,7 +808,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 => [
@@ -971,7 +971,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'),
@@ -1062,7 +1062,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;
@@ -1107,7 +1107,7 @@ sub _parse_specs {
PTDEBUG && _d('Option', $long, 'disables', @participants);
}
return;
return;
}
sub _get_participants {
@@ -1194,7 +1194,7 @@ sub _set_option {
}
sub get_opts {
my ( $self ) = @_;
my ( $self ) = @_;
foreach my $long ( keys %{$self->{opts}} ) {
$self->{opts}->{$long}->{got} = 0;
@@ -1325,7 +1325,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};
@@ -1335,7 +1335,7 @@ sub _check_opts {
}
}
elsif ( $opt->{is_required} ) {
elsif ( $opt->{is_required} ) {
$self->save_error("Required option --$long must be specified");
}
@@ -1719,7 +1719,7 @@ sub clone {
$clone{$scalar} = $self->{$scalar};
}
return bless \%clone;
return bless \%clone;
}
sub _parse_size {
@@ -1858,10 +1858,10 @@ if ( PTDEBUG ) {
# ###########################################################################
# 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;
@@ -1945,7 +1945,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};
@@ -2085,7 +2085,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) };
@@ -2283,7 +2283,7 @@ sub set_vars {
}
}
return;
return;
}
sub _d {
@@ -2303,10 +2303,10 @@ sub _d {
# ###########################################################################
# Cxn 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/Cxn.pm
# t/lib/Cxn.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package Cxn;
@@ -2454,7 +2454,7 @@ sub name {
sub description {
my ($self) = @_;
return sprintf("%s -> %s:%s", $self->name(), $self->{dsn}->{h}, $self->{dsn}->{P} || 'socket');
return sprintf("%s -> %s:%s", $self->name(), $self->{dsn}->{h} || 'localhost' , $self->{dsn}->{P} || 'socket');
}
sub get_id {
@@ -2467,7 +2467,7 @@ sub get_id {
my $sql = q{SHOW STATUS LIKE 'wsrep\_local\_index'};
my (undef, $wsrep_local_index) = $cxn->dbh->selectrow_array($sql);
PTDEBUG && _d("Got cluster wsrep_local_index: ",$wsrep_local_index);
$unique_id = $wsrep_local_index."|";
$unique_id = $wsrep_local_index."|";
foreach my $val ('server\_id', 'wsrep\_sst\_receive\_address', 'wsrep\_node\_name', 'wsrep\_node\_address') {
my $sql = "SHOW VARIABLES LIKE '$val'";
PTDEBUG && _d($cxn->name, $sql);
@@ -2497,7 +2497,7 @@ sub is_cluster_node {
PTDEBUG && _d($sql); #don't invoke name() if it's not a Cxn!
}
else {
$dbh = $cxn->dbh();
$dbh = $cxn->dbh();
PTDEBUG && _d($cxn->name, $sql);
}
@@ -2567,10 +2567,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;
@@ -2578,157 +2578,214 @@ package Daemon;
use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use POSIX qw(setsid);
use Fcntl qw(:DEFAULT);
sub new {
my ( $class, %args ) = @_;
foreach my $arg ( qw(o) ) {
die "I need a $arg argument" unless $args{$arg};
}
my $o = $args{o};
my ($class, %args) = @_;
my $self = {
o => $o,
log_file => $o->has('log') ? $o->get('log') : undef,
PID_file => $o->has('pid') ? $o->get('pid') : undef,
log_file => $args{log_file},
pid_file => $args{pid_file},
daemonize => $args{daemonize},
force_log_file => $args{force_log_file},
parent_exit => $args{parent_exit},
pid_file_owner => 0,
};
check_PID_file(undef, $self->{PID_file});
PTDEBUG && _d('Daemonized child will log to', $self->{log_file});
return bless $self, $class;
}
sub daemonize {
my ( $self ) = @_;
sub run {
my ($self) = @_;
PTDEBUG && _d('About to fork and daemonize');
defined (my $pid = fork()) or die "Cannot fork: $OS_ERROR";
if ( $pid ) {
PTDEBUG && _d('Parent PID', $PID, 'exiting after forking child PID',$pid);
exit;
}
my $daemonize = $self->{daemonize};
my $pid_file = $self->{pid_file};
my $log_file = $self->{log_file};
my $force_log_file = $self->{force_log_file};
my $parent_exit = $self->{parent_exit};
PTDEBUG && _d('Daemonizing child PID', $PID);
$self->{PID_owner} = $PID;
$self->{child} = 1;
PTDEBUG && _d('Starting daemon');
POSIX::setsid() or die "Cannot start a new session: $OS_ERROR";
chdir '/' or die "Cannot chdir to /: $OS_ERROR";
$self->_make_PID_file();
$OUTPUT_AUTOFLUSH = 1;
PTDEBUG && _d('Redirecting STDIN to /dev/null');
close STDIN;
open STDIN, '/dev/null'
or die "Cannot reopen STDIN to /dev/null: $OS_ERROR";
if ( $self->{log_file} ) {
PTDEBUG && _d('Redirecting STDOUT and STDERR to', $self->{log_file});
close STDOUT;
open STDOUT, '>>', $self->{log_file}
or die "Cannot open log file $self->{log_file}: $OS_ERROR";
close STDERR;
open STDERR, ">&STDOUT"
or die "Cannot dupe STDERR to STDOUT: $OS_ERROR";
}
else {
if ( -t STDOUT ) {
PTDEBUG && _d('No log file and STDOUT is a terminal;',
'redirecting to /dev/null');
close STDOUT;
open STDOUT, '>', '/dev/null'
or die "Cannot reopen STDOUT to /dev/null: $OS_ERROR";
}
if ( -t STDERR ) {
PTDEBUG && _d('No log file and STDERR is a terminal;',
'redirecting to /dev/null');
close STDERR;
open STDERR, '>', '/dev/null'
or die "Cannot reopen STDERR to /dev/null: $OS_ERROR";
}
}
return;
}
sub check_PID_file {
my ( $self, $file ) = @_;
my $PID_file = $self ? $self->{PID_file} : $file;
PTDEBUG && _d('Checking PID file', $PID_file);
if ( $PID_file && -f $PID_file ) {
my $pid;
if ( $pid_file ) {
eval {
chomp($pid = (slurp_file($PID_file) || ''));
$self->_make_pid_file(
pid => $PID, # parent's pid
pid_file => $pid_file,
);
};
if ( $EVAL_ERROR ) {
die "The PID file $PID_file already exists but it cannot be read: "
. $EVAL_ERROR;
die "$EVAL_ERROR\n" if $EVAL_ERROR;
if ( !$daemonize ) {
$self->{pid_file_owner} = $PID; # parent's pid
}
PTDEBUG && _d('PID file exists; it contains PID', $pid);
if ( $pid ) {
my $pid_is_alive = kill 0, $pid;
if ( $pid_is_alive ) {
die "The PID file $PID_file already exists "
. " and the PID that it contains, $pid, is running";
}
else {
warn "Overwriting PID file $PID_file because the PID that it "
. "contains, $pid, is not running";
}
}
if ( $daemonize ) {
defined (my $child_pid = fork()) or die "Cannot fork: $OS_ERROR";
if ( $child_pid ) {
PTDEBUG && _d('Forked child', $child_pid);
$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";
if ( $pid_file ) {
$self->_update_pid_file(
pid => $PID, # child's pid
pid_file => $pid_file,
);
$self->{pid_file_owner} = $PID;
}
}
if ( $daemonize || $force_log_file ) {
PTDEBUG && _d('Redirecting STDIN to /dev/null');
close STDIN;
open STDIN, '/dev/null'
or die "Cannot reopen STDIN to /dev/null: $OS_ERROR";
if ( $log_file ) {
PTDEBUG && _d('Redirecting STDOUT and STDERR to', $log_file);
close STDOUT;
open STDOUT, '>>', $log_file
or die "Cannot open log file $log_file: $OS_ERROR";
close STDERR;
open STDERR, ">&STDOUT"
or die "Cannot dupe STDERR to STDOUT: $OS_ERROR";
}
else {
die "The PID file $PID_file already exists but it does not "
. "contain a PID";
if ( -t STDOUT ) {
PTDEBUG && _d('No log file and STDOUT is a terminal;',
'redirecting to /dev/null');
close STDOUT;
open STDOUT, '>', '/dev/null'
or die "Cannot reopen STDOUT to /dev/null: $OS_ERROR";
}
if ( -t STDERR ) {
PTDEBUG && _d('No log file and STDERR is a terminal;',
'redirecting to /dev/null');
close STDERR;
open STDERR, '>', '/dev/null'
or die "Cannot reopen STDERR to /dev/null: $OS_ERROR";
}
}
$OUTPUT_AUTOFLUSH = 1;
}
PTDEBUG && _d('Daemon running');
return;
}
sub _make_pid_file {
my ($self, %args) = @_;
my @required_args = qw(pid pid_file);
foreach my $arg ( @required_args ) {
die "I need a $arg argument" unless $args{$arg};
};
my $pid = $args{pid};
my $pid_file = $args{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;
};
if ( my $e = $EVAL_ERROR ) {
if ( $e =~ m/file exists/i ) {
my $old_pid = $self->_check_pid_file(
pid_file => $pid_file,
pid => $PID,
);
if ( $old_pid ) {
warn "Overwriting PID file $pid_file because PID $old_pid "
. "is not running.\n";
}
$self->_update_pid_file(
pid => $PID,
pid_file => $pid_file
);
}
else {
die "Error creating PID file $pid_file: $e\n";
}
}
else {
PTDEBUG && _d('No PID file');
}
return;
}
sub make_PID_file {
my ( $self ) = @_;
if ( exists $self->{child} ) {
die "Do not call Daemon::make_PID_file() for daemonized scripts";
}
$self->_make_PID_file();
$self->{PID_owner} = $PID;
return;
}
sub _check_pid_file {
my ($self, %args) = @_;
my @required_args = qw(pid_file pid);
foreach my $arg ( @required_args ) {
die "I need a $arg argument" unless $args{$arg};
};
my $pid_file = $args{pid_file};
my $pid = $args{pid};
sub _make_PID_file {
my ( $self ) = @_;
PTDEBUG && _d('Checking if PID in', $pid_file, 'is running');
my $PID_file = $self->{PID_file};
if ( !$PID_file ) {
PTDEBUG && _d('No PID file to create');
if ( ! -f $pid_file ) {
PTDEBUG && _d('PID file', $pid_file, 'does not exist');
return;
}
$self->check_PID_file();
open my $fh, '<', $pid_file
or die "Error opening $pid_file: $OS_ERROR";
my $existing_pid = do { local $/; <$fh> };
chomp($existing_pid) if $existing_pid;
close $fh
or die "Error closing $pid_file: $OS_ERROR";
open my $PID_FH, '>', $PID_file
or die "Cannot open PID file $PID_file: $OS_ERROR";
print $PID_FH $PID
or die "Cannot print to PID file $PID_file: $OS_ERROR";
close $PID_FH
or die "Cannot close PID file $PID_file: $OS_ERROR";
if ( $existing_pid ) {
if ( $existing_pid == $pid ) {
warn "The current PID $pid already holds the PID file $pid_file\n";
return;
}
else {
PTDEBUG && _d('Checking if PID', $existing_pid, 'is running');
my $pid_is_alive = kill 0, $existing_pid;
if ( $pid_is_alive ) {
die "PID file $pid_file exists and PID $existing_pid is running\n";
}
}
}
else {
die "PID file $pid_file exists but it is empty. Remove the file "
. "if the process is no longer running.\n";
}
return $existing_pid;
}
sub _update_pid_file {
my ($self, %args) = @_;
my @required_args = qw(pid pid_file);
foreach my $arg ( @required_args ) {
die "I need a $arg argument" unless $args{$arg};
};
my $pid = $args{pid};
my $pid_file = $args{pid_file};
open my $fh, '>', $pid_file
or die "Cannot open $pid_file: $OS_ERROR";
print { $fh } $pid, "\n"
or die "Cannot print to $pid_file: $OS_ERROR";
close $fh
or warn "Cannot close $pid_file: $OS_ERROR";
PTDEBUG && _d('Created PID file:', $self->{PID_file});
return;
}
sub _remove_PID_file {
my ( $self ) = @_;
if ( $self->{PID_file} && -f $self->{PID_file} ) {
unlink $self->{PID_file}
or warn "Cannot remove PID file $self->{PID_file}: $OS_ERROR";
sub remove_pid_file {
my ($self, $pid_file) = @_;
$pid_file ||= $self->{pid_file};
if ( $pid_file && -f $pid_file ) {
unlink $self->{pid_file}
or warn "Cannot remove PID file $pid_file: $OS_ERROR";
PTDEBUG && _d('Removed PID file');
}
else {
@@ -2738,20 +2795,15 @@ sub _remove_PID_file {
}
sub DESTROY {
my ( $self ) = @_;
my ($self) = @_;
$self->_remove_PID_file() if ($self->{PID_owner} || 0) == $PID;
if ( $self->{pid_file_owner} == $PID ) {
$self->remove_pid_file();
}
return;
}
sub slurp_file {
my ($file) = @_;
return unless $file;
open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR";
return do { local $/; <$fh> };
}
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
@@ -2769,10 +2821,10 @@ sub _d {
# ###########################################################################
# TextResultSetParser 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/TextResultSetParser.pm
# t/lib/TextResultSetParser.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package TextResultSetParser;
@@ -2913,10 +2965,10 @@ sub _d {
# ###########################################################################
# MySQLConfig 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/MySQLConfig.pm
# t/lib/MySQLConfig.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package MySQLConfig;
@@ -2992,13 +3044,13 @@ sub _parse_config {
}
handle_special_vars(\%config_data);
return %config_data;
}
sub handle_special_vars {
my ($config_data) = @_;
if ( $config_data->{vars}->{wsrep_provider_options} ) {
my $vars = $config_data->{vars};
my $dupes = $config_data->{duplicate_vars};
@@ -3060,7 +3112,7 @@ sub _parse_config_output {
vars => $vars,
);
}
return (
format => $format,
vars => $vars,
@@ -3204,7 +3256,7 @@ sub _preprocess_varvals {
}
my ($var, $val) = ($1, $2);
$var =~ tr/-/_/;
$var =~ s/\s*#.*$//;
@@ -3212,7 +3264,7 @@ sub _preprocess_varvals {
if ( !defined $val ) {
$val = '';
}
for my $item ($var, $val) {
$item =~ s/^\s+//;
$item =~ s/\s+$//;
@@ -3266,7 +3318,7 @@ sub _process_val {
$val =~ s/\s*#.*//;
}
if ( my ($num, $factor) = $val =~ m/^(\d+)([KMGT])b?$/i ) {
if ( my ($num, $factor) = $val =~ m/(\d+)([KMGT])b?$/i ) {
my %factor_for = (
k => 1_024,
m => 1_048_576,
@@ -3288,7 +3340,7 @@ sub _mimic_show_variables {
die "I need a $arg arugment" unless $args{$arg};
}
my ($vars, $format) = @args{@required_args};
foreach my $var ( keys %$vars ) {
if ( $vars->{$var} eq '' ) {
if ( $format eq 'mysqld' ) {
@@ -3366,6 +3418,23 @@ sub is_active {
return $self->{dbh} ? 1 : 0;
}
sub has_engine {
my ($self, $engine) = @_;
if (!$self->{dbh}) {
die "invalid dbh in has_engine method";
}
my $rows = $self->{dbh}->selectall_arrayref('SHOW ENGINES', {Slice=>{}});
my $is_enabled;
for my $row (@$rows) {
if ($row->{engine} eq 'ROCKSDB') {
$is_enabled = 1;
last;
}
}
return $is_enabled;
}
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
@@ -3383,10 +3452,10 @@ sub _d {
# ###########################################################################
# MySQLConfigComparer 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/MySQLConfigComparer.pm
# t/lib/MySQLConfigComparer.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package MySQLConfigComparer;
@@ -3420,7 +3489,7 @@ sub new {
);
my %is_numeric = (
long_query_time => 1,
long_query_time => 1,
($args{numeric_variables}
? map { $_ => 1 } @{$args{numeric_variables}}
: ()),
@@ -3433,7 +3502,7 @@ sub new {
($args{optional_value_variables}
? map { $_ => 1 } @{$args{optional_value_variables}}
: ()),
);
);
my %any_value_is_true = (
log => 1,
@@ -3628,10 +3697,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;
@@ -4049,10 +4118,10 @@ no Lmo;
# ###########################################################################
# 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;
@@ -4278,7 +4347,7 @@ sub _split_url {
or die(qq/SSL certificate not valid for $host\n/);
}
}
$self->{host} = $host;
$self->{port} = $port;
@@ -4702,10 +4771,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;
@@ -4753,7 +4822,7 @@ my @vc_dirs = (
}
PTDEBUG && _d('Version check file', $file, 'in', $ENV{PWD});
return $file; # in the CWD
}
}
}
sub version_check_time_limit {
@@ -4770,11 +4839,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;
@@ -4798,7 +4867,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);
@@ -4806,13 +4875,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));
@@ -4970,12 +5041,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;
@@ -5024,7 +5100,7 @@ sub pingback {
);
die "Failed to parse server requested programs: $response->{content}"
if !scalar keys %$items;
my $versions = get_versions(
items => $items,
instances => $instances,
@@ -5038,8 +5114,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));
@@ -5122,6 +5199,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 {
@@ -5249,6 +5327,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};
@@ -5283,7 +5365,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;