percona/percona-toolkit
1
0
Fork 0
mirror of https://github.com/percona/percona-toolkit.git synced 2025-09-03 11:05:48 +00:00
Code Issues Packages Projects Releases Wiki Activity

PT-2340 - Support MySQL 8.4

Browse Source 
- Tests for the minimal SSL support
- Updated util/update-modules, so they don't skip tools with modules, not defined in lib
This commit is contained in:
Sveta Smirnova
2024-09-12 20:33:11 +03:00
parent 045b2fec9f
commit 5d55904436
27 changed files with 2749 additions and 364 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
bin/pt-duplicate-key-checker
View File

@@ -5736,12 +5736,6 @@ dsn: mysql_ssl; copy: yes
Create SSL connection
=item * s
dsn: mysql_ssl; copy: yes
Create SSL connection
=back
=head1 ENVIRONMENT

6
bin/pt-find
View File

@@ -4605,6 +4605,12 @@ short form: -h; type: string
Connect to host.
=item --mysql_ssl
short form: -s; type: int
Create SSL MySQL connection.
=item --or
Combine tests with OR, not AND.

6
bin/pt-index-usage
View File

@@ -7308,6 +7308,12 @@ type: string
Ignore tables whose names match the Perl regex.
=item --mysql_ssl
short form: -s; type: int
Create SSL MySQL connection.
=item --password
short form: -p; type: string

497
bin/pt-table-usage
View File

@@ -42,10 +42,10 @@ BEGIN {
# ###########################################################################
# 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;
@@ -217,7 +217,7 @@ sub get_cxn_params {
$dsn = 'DBI:mysql:' . ( $info->{D} || '' ) . ';'
. join(';', map { "$opts{$_}->{dsn}=$info->{$_}" }
grep { defined $info->{$_} }
qw(F h P S A))
qw(F h P S A s))
. ';mysql_read_default_group=client'
. ($info->{L} ? ';mysql_local_infile=1' : '');
}
@@ -297,21 +297,48 @@ sub get_dbh {
if ( $cxn_string =~ m/mysql/i ) {
my $sql;
if ( my ($charset) = $cxn_string =~ m/charset=([\w]+)/ ) {
my ($charset) = $cxn_string =~ m/charset=([\w]+)/;
if ( $charset ) {
$sql = qq{/*!40101 SET NAMES "$charset"*/};
PTDEBUG && _d($dbh, $sql);
eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) {
die "Error setting NAMES to $charset: $EVAL_ERROR";
}
PTDEBUG && _d('Enabling charset for STDOUT');
if ( $charset eq 'utf8' ) {
binmode(STDOUT, ':utf8')
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
}
else {
my ($mysql_version) = eval { $dbh->selectrow_array('SELECT VERSION()') };
if ( $EVAL_ERROR ) {
die "Cannot get MySQL version: $EVAL_ERROR";
}
else {
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_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;
$charset = $character_set_server;
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 '$character_set_server'") };
if ( $EVAL_ERROR ) {
die "Cannot SET NAMES $character_set_server: $EVAL_ERROR";
}
}
}
}
PTDEBUG && _d('Enabling charset for STDOUT');
if ( $charset && $charset =~ m/^utf8/ ) {
binmode(STDOUT, ':utf8')
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
binmode(STDERR, ':utf8')
or die "Can't binmode(STDERR, ':utf8'): $OS_ERROR";
}
else {
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
}
if ( my $vars = $self->prop('set-vars') ) {
@@ -337,28 +364,6 @@ sub get_dbh {
. ": $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,
@@ -487,10 +492,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;
@@ -547,10 +552,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;
@@ -604,10 +609,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;
@@ -2248,10 +2253,10 @@ if ( PTDEBUG ) {
# ###########################################################################
# 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;
@@ -2476,10 +2481,10 @@ sub _d {
# ###########################################################################
# 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;
@@ -2702,7 +2707,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;
}
@@ -3238,10 +3243,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;
@@ -3297,7 +3302,7 @@ sub get_tables {
return ($tbl);
}
$query =~ s/ (?:LOW_PRIORITY|IGNORE|STRAIGHT_JOIN)//ig;
$query =~ s/(?:LOW_PRIORITY|IGNORE|STRAIGHT_JOIN|DELAYED)\s+/ /ig;
if ( $query =~ s/^\s*LOCK TABLES\s+//i ) {
PTDEBUG && _d('Special table type: LOCK TABLES');
@@ -3306,9 +3311,18 @@ sub get_tables {
$query = "FROM $query";
}
$query =~ s/\\["']//g; # quoted strings
$query =~ s/".*?"/?/sg; # quoted strings
$query =~ s/'.*?'/?/sg; # quoted strings
$query =~ s/\\["']//g; # quoted strings
$query =~ s/".*?"/?/sg; # quoted strings
$query =~ s/'.*?'/?/sg; # quoted strings
if ( $query =~ m/\A\s*(?:INSERT|REPLACE)(?!\s+INTO)/i ) {
$query =~ s/\A\s*((?:INSERT|REPLACE))\s+/$1 INTO /i;
}
if ( $query =~ m/\A\s*LOAD DATA/i ) {
my ($tbl) = $query =~ m/INTO TABLE\s+(\S+)/i;
return $tbl;
}
my @tables;
foreach my $tbls ( $query =~ m/$tbl_regex/gio ) {
@@ -3834,10 +3848,10 @@ no Lmo;
# ###########################################################################
# 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;
@@ -4919,10 +4933,10 @@ sub _d {
# ###########################################################################
# TableUsage 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/TableUsage.pm
# t/lib/TableUsage.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package TableUsage;
@@ -4936,6 +4950,7 @@ use Data::Dumper;
$Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Quotekeys = 0;
use VersionParser;
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
@@ -5897,10 +5912,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;
@@ -5908,157 +5923,225 @@ 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,
utf8 => $args{utf8} // 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};
my $utf8 = $self->{utf8};
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";
}
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";
if ( $utf8 ) {
binmode(STDOUT, ':utf8')
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
}
else {
warn "Overwriting PID file $PID_file because the PID that it "
. "contains, $pid, is not running";
close STDERR;
open STDERR, ">&STDOUT"
or die "Cannot dupe STDERR to STDOUT: $OS_ERROR";
if ( $utf8 ) {
binmode(STDERR, ':utf8')
or die "Can't binmode(STDERR, ':utf8'): $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 {
@@ -6068,20 +6151,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; }
@@ -6099,10 +6177,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;
@@ -6232,10 +6310,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;
@@ -6379,10 +6457,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;
@@ -6563,10 +6641,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;
@@ -6602,6 +6680,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'";
}
@@ -6714,10 +6794,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;
@@ -6777,13 +6857,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 ) {
@@ -6812,7 +6894,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));
@@ -6952,11 +7034,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);
@@ -6993,8 +7093,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;
@@ -7004,7 +7103,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|`[^`]*`)/;
@@ -7032,7 +7131,7 @@ sub get_keys {
ddl => $key_ddl,
};
if ( ($engine || '') =~ m/InnoDB/i && !$clustered_key ) {
if ( ($engine || '') =~ m/(InnoDB)|(TokuDB)|(RocksDB)/i && !$clustered_key ) {
my $this_key = $keys->{$name};
if ( $this_key->{name} eq 'PRIMARY' ) {
$clustered_key = 'PRIMARY';

590
bin/pt-visual-explain
View File

@@ -18,6 +18,7 @@ BEGIN {
OptionParser
DSNParser
Daemon
VersionParser
));
}
@@ -1814,7 +1815,7 @@ 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://github.com/percona/percona-toolkit for more information.
@@ -1989,7 +1990,7 @@ sub get_cxn_params {
$dsn = 'DBI:mysql:' . ( $info->{D} || '' ) . ';'
. join(';', map { "$opts{$_}->{dsn}=$info->{$_}" }
grep { defined $info->{$_} }
qw(F h P S A))
qw(F h P S A s))
. ';mysql_read_default_group=client'
. ($info->{L} ? ';mysql_local_infile=1' : '');
}
@@ -2069,21 +2070,48 @@ sub get_dbh {
if ( $cxn_string =~ m/mysql/i ) {
my $sql;
if ( my ($charset) = $cxn_string =~ m/charset=([\w]+)/ ) {
my ($charset) = $cxn_string =~ m/charset=([\w]+)/;
if ( $charset ) {
$sql = qq{/*!40101 SET NAMES "$charset"*/};
PTDEBUG && _d($dbh, $sql);
eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) {
die "Error setting NAMES to $charset: $EVAL_ERROR";
}
PTDEBUG && _d('Enabling charset for STDOUT');
if ( $charset eq 'utf8' ) {
binmode(STDOUT, ':utf8')
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
}
else {
my ($mysql_version) = eval { $dbh->selectrow_array('SELECT VERSION()') };
if ( $EVAL_ERROR ) {
die "Cannot get MySQL version: $EVAL_ERROR";
}
else {
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_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;
$charset = $character_set_server;
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 '$character_set_server'") };
if ( $EVAL_ERROR ) {
die "Cannot SET NAMES $character_set_server: $EVAL_ERROR";
}
}
}
}
PTDEBUG && _d('Enabling charset for STDOUT');
if ( $charset && $charset =~ m/^utf8/ ) {
binmode(STDOUT, ':utf8')
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
binmode(STDERR, ':utf8')
or die "Can't binmode(STDERR, ':utf8'): $OS_ERROR";
}
else {
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
}
if ( my $vars = $self->prop('set-vars') ) {
@@ -2109,28 +2137,6 @@ sub get_dbh {
. ": $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,
@@ -2259,7 +2265,7 @@ 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://github.com/percona/percona-toolkit for more information.
@@ -2270,157 +2276,225 @@ 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,
utf8 => $args{utf8} // 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};
my $utf8 = $self->{utf8};
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";
}
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";
if ( $utf8 ) {
binmode(STDOUT, ':utf8')
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
}
else {
warn "Overwriting PID file $PID_file because the PID that it "
. "contains, $pid, is not running";
close STDERR;
open STDERR, ">&STDOUT"
or die "Cannot dupe STDERR to STDOUT: $OS_ERROR";
if ( $utf8 ) {
binmode(STDERR, ':utf8')
or die "Can't binmode(STDERR, ':utf8'): $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 {
@@ -2430,20 +2504,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; }
@@ -2458,6 +2527,198 @@ sub _d {
# End Daemon package
# ###########################################################################
# ###########################################################################
# VersionParser package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the GitHub repository at,
# lib/VersionParser.pm
# t/lib/VersionParser.t
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package VersionParser;
use Lmo;
use Scalar::Util qw(blessed);
use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use overload (
'""' => "version",
'<=>' => "cmp",
'cmp' => "cmp",
fallback => 1,
);
use Carp ();
has major => (
is => 'ro',
isa => 'Int',
required => 1,
);
has [qw( minor revision )] => (
is => 'ro',
isa => 'Num',
);
has flavor => (
is => 'ro',
isa => 'Str',
default => sub { 'Unknown' },
);
has innodb_version => (
is => 'ro',
isa => 'Str',
default => sub { 'NO' },
);
sub series {
my $self = shift;
return $self->_join_version($self->major, $self->minor);
}
sub version {
my $self = shift;
return $self->_join_version($self->major, $self->minor, $self->revision);
}
sub is_in {
my ($self, $target) = @_;
return $self eq $target;
}
sub _join_version {
my ($self, @parts) = @_;
return join ".", map { my $c = $_; $c =~ s/^0\./0/; $c } grep defined, @parts;
}
sub _split_version {
my ($self, $str) = @_;
my @version_parts = map { s/^0(?=\d)/0./; $_ } $str =~ m/(\d+)/g;
return @version_parts[0..2];
}
sub normalized_version {
my ( $self ) = @_;
my $result = sprintf('%d%02d%02d', map { $_ || 0 } $self->major,
$self->minor,
$self->revision);
PTDEBUG && _d($self->version, 'normalizes to', $result);
return $result;
}
sub comment {
my ( $self, $cmd ) = @_;
my $v = $self->normalized_version();
return "/*!$v $cmd */"
}
my @methods = qw(major minor revision);
sub cmp {
my ($left, $right) = @_;
my $right_obj = (blessed($right) && $right->isa(ref($left)))
? $right
: ref($left)->new($right);
my $retval = 0;
for my $m ( @methods ) {
last unless defined($left->$m) && defined($right_obj->$m);
$retval = $left->$m <=> $right_obj->$m;
last if $retval;
}
return $retval;
}
sub BUILDARGS {
my $self = shift;
if ( @_ == 1 ) {
my %args;
if ( blessed($_[0]) && $_[0]->can("selectrow_hashref") ) {
PTDEBUG && _d("VersionParser got a dbh, trying to get the version");
my $dbh = $_[0];
local $dbh->{FetchHashKeyName} = 'NAME_lc';
my $query = eval {
$dbh->selectall_arrayref(q/SHOW VARIABLES LIKE 'version%'/, { Slice => {} })
};
if ( $query ) {
$query = { map { $_->{variable_name} => $_->{value} } @$query };
@args{@methods} = $self->_split_version($query->{version});
$args{flavor} = delete $query->{version_comment}
if $query->{version_comment};
}
elsif ( eval { ($query) = $dbh->selectrow_array(q/SELECT VERSION()/) } ) {
@args{@methods} = $self->_split_version($query);
}
else {
Carp::confess("Couldn't get the version from the dbh while "
. "creating a VersionParser object: $@");
}
$args{innodb_version} = eval { $self->_innodb_version($dbh) };
}
elsif ( !ref($_[0]) ) {
@args{@methods} = $self->_split_version($_[0]);
}
for my $method (@methods) {
delete $args{$method} unless defined $args{$method};
}
@_ = %args if %args;
}
return $self->SUPER::BUILDARGS(@_);
}
sub _innodb_version {
my ( $self, $dbh ) = @_;
return unless $dbh;
my $innodb_version = "NO";
my ($innodb) =
grep { $_->{engine} =~ m/InnoDB/i }
map {
my %hash;
@hash{ map { lc $_ } keys %$_ } = values %$_;
\%hash;
}
@{ $dbh->selectall_arrayref("SHOW ENGINES", {Slice=>{}}) };
if ( $innodb ) {
PTDEBUG && _d("InnoDB support:", $innodb->{support});
if ( $innodb->{support} =~ m/YES|DEFAULT/i ) {
my $vars = $dbh->selectrow_hashref(
"SHOW VARIABLES LIKE 'innodb_version'");
$innodb_version = !$vars ? "BUILTIN"
: ($vars->{Value} || $vars->{value});
}
else {
$innodb_version = $innodb->{support}; # probably DISABLED or NO
}
}
PTDEBUG && _d("InnoDB version:", $innodb_version);
return $innodb_version;
}
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
no Lmo;
1;
}
# ###########################################################################
# End VersionParser package
# ###########################################################################
# ###########################################################################
# This is a combination of modules and programs in one -- a runnable module.
# http://www.perl.com/pub/a/2006/07/13/lightning-articles.html?page=last
@@ -2518,7 +2779,12 @@ sub main {
my $dsn = $dp->parse_options($o);
my $dbh = $dp->get_dbh($dp->get_cxn_params($dsn), { AutoCommit => 1 } );
$text =~ s{^.*?select}{EXPLAIN /*!50115 PARTITIONS*/ SELECT}is;
my $vp = VersionParser->new($dbh);
if ( $vp->cmp('8.0') < 0 || $vp->flavor() =~ m/maria/i ) {
$text =~ s{^.*?select}{EXPLAIN /*!50115 PARTITIONS*/ SELECT}is;
} else {
$text =~ s{^.*?select}{EXPLAIN SELECT}is;
}
$rows = $dbh->selectall_arrayref($text, { Slice => {} } );
$dbh->disconnect();
}
@@ -3045,6 +3311,8 @@ first option on the command line.
=item --connect
short form: -c
Treat input as a query, and obtain EXPLAIN output by connecting to a MySQL
instance and running EXPLAIN on the query. When this option is given,
pt-visual-explain uses the other connection-specific options such as
@@ -3088,6 +3356,12 @@ short form: -h; type: string
Connect to host.
=item --mysql_ssl
short form: -s; type: int
Create SSL MySQL connection.
=item --password
short form: -p; type: string