percona/percona-toolkit
1
0
Fork 0
mirror of https://github.com/percona/percona-toolkit.git synced 2025-09-10 21:19:59 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge p:~percona-toolkit-dev/percona-toolkit/fix-1087319-quoter-multiple-nulls

Browse Source
This commit is contained in:
Daniel Nichter
2013-02-19 13:01:58 -07:00
parent d023c90e8e 1726cf2bb8
commit 07b818b730
37 changed files with 1095 additions and 731 deletions
Download Patch File Download Diff File Expand all files Collapse all files

79
bin/pt-archiver
View File

@@ -2717,6 +2717,11 @@ use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use Data::Dumper;
$Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Quotekeys = 0;
sub new {
my ( $class, %args ) = @_;
return bless {}, $class;
@@ -2781,44 +2786,64 @@ sub join_quote {
sub serialize_list {
my ( $self, @args ) = @_;
PTDEBUG && _d('Serializing', Dumper(\@args));
return unless @args;
return $args[0] if @args == 1 && !defined $args[0];
my @parts;
foreach my $arg ( @args ) {
if ( defined $arg ) {
$arg =~ s/,/\\,/g; # escape commas
$arg =~ s/\\N/\\\\N/g; # escape literal \N
push @parts, $arg;
}
else {
push @parts, '\N';
}
}
die "Cannot serialize multiple values with undef/NULL"
if grep { !defined $_ } @args;
return join ',', map { quotemeta } @args;
my $string = join(',', @parts);
PTDEBUG && _d('Serialized: <', $string, '>');
return $string;
}
sub deserialize_list {
my ( $self, $string ) = @_;
return $string unless defined $string;
my @escaped_parts = $string =~ /
\G # Start of string, or end of previous match.
( # Each of these is an element in the original list.
[^\\,]* # Anything not a backslash or a comma
(?: # When we get here, we found one of the above.
\\. # A backslash followed by something so we can continue
[^\\,]* # Same as above.
)* # Repeat zero of more times.
)
, # Comma dividing elements
/sxgc;
PTDEBUG && _d('Deserializing <', $string, '>');
die "Cannot deserialize an undefined string" unless defined $string;
push @escaped_parts, pos($string) ? substr( $string, pos($string) ) : $string;
my @parts;
foreach my $arg ( split(/(?<!\\),/, $string) ) {
if ( $arg eq '\N' ) {
$arg = undef;
}
else {
$arg =~ s/\\,/,/g;
$arg =~ s/\\\\N/\\N/g;
}
push @parts, $arg;
}
my @unescaped_parts = map {
my $part = $_;
if ( !@parts ) {
my $n_empty_strings = $string =~ tr/,//;
$n_empty_strings++;
PTDEBUG && _d($n_empty_strings, 'empty strings');
map { push @parts, '' } 1..$n_empty_strings;
}
elsif ( $string =~ m/(?<!\\),$/ ) {
PTDEBUG && _d('Last value is an empty string');
push @parts, '';
}
my $char_class = utf8::is_utf8($part) # If it's a UTF-8 string,
? qr/(?=\p{ASCII})\W/ # We only care about non-word
: qr/(?=\p{ASCII})\W|[\x{80}-\x{FF}]/; # Otherwise,
$part =~ s/\\($char_class)/$1/g;
$part;
} @escaped_parts;
PTDEBUG && _d('Deserialized', Dumper(\@parts));
return @parts;
}
return @unescaped_parts;
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";
}
1;

79
bin/pt-deadlock-logger
View File

@@ -1926,6 +1926,11 @@ use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use Data::Dumper;
$Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Quotekeys = 0;
sub new {
my ( $class, %args ) = @_;
return bless {}, $class;
@@ -1990,44 +1995,64 @@ sub join_quote {
sub serialize_list {
my ( $self, @args ) = @_;
PTDEBUG && _d('Serializing', Dumper(\@args));
return unless @args;
return $args[0] if @args == 1 && !defined $args[0];
my @parts;
foreach my $arg ( @args ) {
if ( defined $arg ) {
$arg =~ s/,/\\,/g; # escape commas
$arg =~ s/\\N/\\\\N/g; # escape literal \N
push @parts, $arg;
}
else {
push @parts, '\N';
}
}
die "Cannot serialize multiple values with undef/NULL"
if grep { !defined $_ } @args;
return join ',', map { quotemeta } @args;
my $string = join(',', @parts);
PTDEBUG && _d('Serialized: <', $string, '>');
return $string;
}
sub deserialize_list {
my ( $self, $string ) = @_;
return $string unless defined $string;
my @escaped_parts = $string =~ /
\G # Start of string, or end of previous match.
( # Each of these is an element in the original list.
[^\\,]* # Anything not a backslash or a comma
(?: # When we get here, we found one of the above.
\\. # A backslash followed by something so we can continue
[^\\,]* # Same as above.
)* # Repeat zero of more times.
)
, # Comma dividing elements
/sxgc;
PTDEBUG && _d('Deserializing <', $string, '>');
die "Cannot deserialize an undefined string" unless defined $string;
push @escaped_parts, pos($string) ? substr( $string, pos($string) ) : $string;
my @parts;
foreach my $arg ( split(/(?<!\\),/, $string) ) {
if ( $arg eq '\N' ) {
$arg = undef;
}
else {
$arg =~ s/\\,/,/g;
$arg =~ s/\\\\N/\\N/g;
}
push @parts, $arg;
}
my @unescaped_parts = map {
my $part = $_;
if ( !@parts ) {
my $n_empty_strings = $string =~ tr/,//;
$n_empty_strings++;
PTDEBUG && _d($n_empty_strings, 'empty strings');
map { push @parts, '' } 1..$n_empty_strings;
}
elsif ( $string =~ m/(?<!\\),$/ ) {
PTDEBUG && _d('Last value is an empty string');
push @parts, '';
}
my $char_class = utf8::is_utf8($part) # If it's a UTF-8 string,
? qr/(?=\p{ASCII})\W/ # We only care about non-word
: qr/(?=\p{ASCII})\W|[\x{80}-\x{FF}]/; # Otherwise,
$part =~ s/\\($char_class)/$1/g;
$part;
} @escaped_parts;
PTDEBUG && _d('Deserialized', Dumper(\@parts));
return @parts;
}
return @unescaped_parts;
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";
}
1;

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

@@ -62,6 +62,11 @@ use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use Data::Dumper;
$Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Quotekeys = 0;
sub new {
my ( $class, %args ) = @_;
return bless {}, $class;
@@ -126,44 +131,64 @@ sub join_quote {
sub serialize_list {
my ( $self, @args ) = @_;
PTDEBUG && _d('Serializing', Dumper(\@args));
return unless @args;
return $args[0] if @args == 1 && !defined $args[0];
my @parts;
foreach my $arg ( @args ) {
if ( defined $arg ) {
$arg =~ s/,/\\,/g; # escape commas
$arg =~ s/\\N/\\\\N/g; # escape literal \N
push @parts, $arg;
}
else {
push @parts, '\N';
}
}
die "Cannot serialize multiple values with undef/NULL"
if grep { !defined $_ } @args;
return join ',', map { quotemeta } @args;
my $string = join(',', @parts);
PTDEBUG && _d('Serialized: <', $string, '>');
return $string;
}
sub deserialize_list {
my ( $self, $string ) = @_;
return $string unless defined $string;
my @escaped_parts = $string =~ /
\G # Start of string, or end of previous match.
( # Each of these is an element in the original list.
[^\\,]* # Anything not a backslash or a comma
(?: # When we get here, we found one of the above.
\\. # A backslash followed by something so we can continue
[^\\,]* # Same as above.
)* # Repeat zero of more times.
)
, # Comma dividing elements
/sxgc;
PTDEBUG && _d('Deserializing <', $string, '>');
die "Cannot deserialize an undefined string" unless defined $string;
push @escaped_parts, pos($string) ? substr( $string, pos($string) ) : $string;
my @parts;
foreach my $arg ( split(/(?<!\\),/, $string) ) {
if ( $arg eq '\N' ) {
$arg = undef;
}
else {
$arg =~ s/\\,/,/g;
$arg =~ s/\\\\N/\\N/g;
}
push @parts, $arg;
}
my @unescaped_parts = map {
my $part = $_;
if ( !@parts ) {
my $n_empty_strings = $string =~ tr/,//;
$n_empty_strings++;
PTDEBUG && _d($n_empty_strings, 'empty strings');
map { push @parts, '' } 1..$n_empty_strings;
}
elsif ( $string =~ m/(?<!\\),$/ ) {
PTDEBUG && _d('Last value is an empty string');
push @parts, '';
}
my $char_class = utf8::is_utf8($part) # If it's a UTF-8 string,
? qr/(?=\p{ASCII})\W/ # We only care about non-word
: qr/(?=\p{ASCII})\W|[\x{80}-\x{FF}]/; # Otherwise,
$part =~ s/\\($char_class)/$1/g;
$part;
} @escaped_parts;
PTDEBUG && _d('Deserialized', Dumper(\@parts));
return @parts;
}
return @unescaped_parts;
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";
}
1;

79
bin/pt-find
View File

@@ -1460,6 +1460,11 @@ use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use Data::Dumper;
$Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Quotekeys = 0;
sub new {
my ( $class, %args ) = @_;
return bless {}, $class;
@@ -1524,44 +1529,64 @@ sub join_quote {
sub serialize_list {
my ( $self, @args ) = @_;
PTDEBUG && _d('Serializing', Dumper(\@args));
return unless @args;
return $args[0] if @args == 1 && !defined $args[0];
my @parts;
foreach my $arg ( @args ) {
if ( defined $arg ) {
$arg =~ s/,/\\,/g; # escape commas
$arg =~ s/\\N/\\\\N/g; # escape literal \N
push @parts, $arg;
}
else {
push @parts, '\N';
}
}
die "Cannot serialize multiple values with undef/NULL"
if grep { !defined $_ } @args;
return join ',', map { quotemeta } @args;
my $string = join(',', @parts);
PTDEBUG && _d('Serialized: <', $string, '>');
return $string;
}
sub deserialize_list {
my ( $self, $string ) = @_;
return $string unless defined $string;
my @escaped_parts = $string =~ /
\G # Start of string, or end of previous match.
( # Each of these is an element in the original list.
[^\\,]* # Anything not a backslash or a comma
(?: # When we get here, we found one of the above.
\\. # A backslash followed by something so we can continue
[^\\,]* # Same as above.
)* # Repeat zero of more times.
)
, # Comma dividing elements
/sxgc;
PTDEBUG && _d('Deserializing <', $string, '>');
die "Cannot deserialize an undefined string" unless defined $string;
push @escaped_parts, pos($string) ? substr( $string, pos($string) ) : $string;
my @parts;
foreach my $arg ( split(/(?<!\\),/, $string) ) {
if ( $arg eq '\N' ) {
$arg = undef;
}
else {
$arg =~ s/\\,/,/g;
$arg =~ s/\\\\N/\\N/g;
}
push @parts, $arg;
}
my @unescaped_parts = map {
my $part = $_;
if ( !@parts ) {
my $n_empty_strings = $string =~ tr/,//;
$n_empty_strings++;
PTDEBUG && _d($n_empty_strings, 'empty strings');
map { push @parts, '' } 1..$n_empty_strings;
}
elsif ( $string =~ m/(?<!\\),$/ ) {
PTDEBUG && _d('Last value is an empty string');
push @parts, '';
}
my $char_class = utf8::is_utf8($part) # If it's a UTF-8 string,
? qr/(?=\p{ASCII})\W/ # We only care about non-word
: qr/(?=\p{ASCII})\W|[\x{80}-\x{FF}]/; # Otherwise,
$part =~ s/\\($char_class)/$1/g;
$part;
} @escaped_parts;
PTDEBUG && _d('Deserialized', Dumper(\@parts));
return @parts;
}
return @unescaped_parts;
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";
}
1;

79
bin/pt-fk-error-logger
View File

@@ -1083,6 +1083,11 @@ use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use Data::Dumper;
$Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Quotekeys = 0;
sub new {
my ( $class, %args ) = @_;
return bless {}, $class;
@@ -1147,44 +1152,64 @@ sub join_quote {
sub serialize_list {
my ( $self, @args ) = @_;
PTDEBUG && _d('Serializing', Dumper(\@args));
return unless @args;
return $args[0] if @args == 1 && !defined $args[0];
my @parts;
foreach my $arg ( @args ) {
if ( defined $arg ) {
$arg =~ s/,/\\,/g; # escape commas
$arg =~ s/\\N/\\\\N/g; # escape literal \N
push @parts, $arg;
}
else {
push @parts, '\N';
}
}
die "Cannot serialize multiple values with undef/NULL"
if grep { !defined $_ } @args;
return join ',', map { quotemeta } @args;
my $string = join(',', @parts);
PTDEBUG && _d('Serialized: <', $string, '>');
return $string;
}
sub deserialize_list {
my ( $self, $string ) = @_;
return $string unless defined $string;
my @escaped_parts = $string =~ /
\G # Start of string, or end of previous match.
( # Each of these is an element in the original list.
[^\\,]* # Anything not a backslash or a comma
(?: # When we get here, we found one of the above.
\\. # A backslash followed by something so we can continue
[^\\,]* # Same as above.
)* # Repeat zero of more times.
)
, # Comma dividing elements
/sxgc;
PTDEBUG && _d('Deserializing <', $string, '>');
die "Cannot deserialize an undefined string" unless defined $string;
push @escaped_parts, pos($string) ? substr( $string, pos($string) ) : $string;
my @parts;
foreach my $arg ( split(/(?<!\\),/, $string) ) {
if ( $arg eq '\N' ) {
$arg = undef;
}
else {
$arg =~ s/\\,/,/g;
$arg =~ s/\\\\N/\\N/g;
}
push @parts, $arg;
}
my @unescaped_parts = map {
my $part = $_;
if ( !@parts ) {
my $n_empty_strings = $string =~ tr/,//;
$n_empty_strings++;
PTDEBUG && _d($n_empty_strings, 'empty strings');
map { push @parts, '' } 1..$n_empty_strings;
}
elsif ( $string =~ m/(?<!\\),$/ ) {
PTDEBUG && _d('Last value is an empty string');
push @parts, '';
}
my $char_class = utf8::is_utf8($part) # If it's a UTF-8 string,
? qr/(?=\p{ASCII})\W/ # We only care about non-word
: qr/(?=\p{ASCII})\W|[\x{80}-\x{FF}]/; # Otherwise,
$part =~ s/\\($char_class)/$1/g;
$part;
} @escaped_parts;
PTDEBUG && _d('Deserialized', Dumper(\@parts));
return @parts;
}
return @unescaped_parts;
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";
}
1;

79
bin/pt-heartbeat
View File

@@ -2399,6 +2399,11 @@ use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use Data::Dumper;
$Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Quotekeys = 0;
sub new {
my ( $class, %args ) = @_;
return bless {}, $class;
@@ -2463,44 +2468,64 @@ sub join_quote {
sub serialize_list {
my ( $self, @args ) = @_;
PTDEBUG && _d('Serializing', Dumper(\@args));
return unless @args;
return $args[0] if @args == 1 && !defined $args[0];
my @parts;
foreach my $arg ( @args ) {
if ( defined $arg ) {
$arg =~ s/,/\\,/g; # escape commas
$arg =~ s/\\N/\\\\N/g; # escape literal \N
push @parts, $arg;
}
else {
push @parts, '\N';
}
}
die "Cannot serialize multiple values with undef/NULL"
if grep { !defined $_ } @args;
return join ',', map { quotemeta } @args;
my $string = join(',', @parts);
PTDEBUG && _d('Serialized: <', $string, '>');
return $string;
}
sub deserialize_list {
my ( $self, $string ) = @_;
return $string unless defined $string;
my @escaped_parts = $string =~ /
\G # Start of string, or end of previous match.
( # Each of these is an element in the original list.
[^\\,]* # Anything not a backslash or a comma
(?: # When we get here, we found one of the above.
\\. # A backslash followed by something so we can continue
[^\\,]* # Same as above.
)* # Repeat zero of more times.
)
, # Comma dividing elements
/sxgc;
PTDEBUG && _d('Deserializing <', $string, '>');
die "Cannot deserialize an undefined string" unless defined $string;
push @escaped_parts, pos($string) ? substr( $string, pos($string) ) : $string;
my @parts;
foreach my $arg ( split(/(?<!\\),/, $string) ) {
if ( $arg eq '\N' ) {
$arg = undef;
}
else {
$arg =~ s/\\,/,/g;
$arg =~ s/\\\\N/\\N/g;
}
push @parts, $arg;
}
my @unescaped_parts = map {
my $part = $_;
if ( !@parts ) {
my $n_empty_strings = $string =~ tr/,//;
$n_empty_strings++;
PTDEBUG && _d($n_empty_strings, 'empty strings');
map { push @parts, '' } 1..$n_empty_strings;
}
elsif ( $string =~ m/(?<!\\),$/ ) {
PTDEBUG && _d('Last value is an empty string');
push @parts, '';
}
my $char_class = utf8::is_utf8($part) # If it's a UTF-8 string,
? qr/(?=\p{ASCII})\W/ # We only care about non-word
: qr/(?=\p{ASCII})\W|[\x{80}-\x{FF}]/; # Otherwise,
$part =~ s/\\($char_class)/$1/g;
$part;
} @escaped_parts;
PTDEBUG && _d('Deserialized', Dumper(\@parts));
return @parts;
}
return @unescaped_parts;
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";
}
1;

79
bin/pt-index-usage
View File

@@ -445,6 +445,11 @@ use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use Data::Dumper;
$Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Quotekeys = 0;
sub new {
my ( $class, %args ) = @_;
return bless {}, $class;
@@ -509,44 +514,64 @@ sub join_quote {
sub serialize_list {
my ( $self, @args ) = @_;
PTDEBUG && _d('Serializing', Dumper(\@args));
return unless @args;
return $args[0] if @args == 1 && !defined $args[0];
my @parts;
foreach my $arg ( @args ) {
if ( defined $arg ) {
$arg =~ s/,/\\,/g; # escape commas
$arg =~ s/\\N/\\\\N/g; # escape literal \N
push @parts, $arg;
}
else {
push @parts, '\N';
}
}
die "Cannot serialize multiple values with undef/NULL"
if grep { !defined $_ } @args;
return join ',', map { quotemeta } @args;
my $string = join(',', @parts);
PTDEBUG && _d('Serialized: <', $string, '>');
return $string;
}
sub deserialize_list {
my ( $self, $string ) = @_;
return $string unless defined $string;
my @escaped_parts = $string =~ /
\G # Start of string, or end of previous match.
( # Each of these is an element in the original list.
[^\\,]* # Anything not a backslash or a comma
(?: # When we get here, we found one of the above.
\\. # A backslash followed by something so we can continue
[^\\,]* # Same as above.
)* # Repeat zero of more times.
)
, # Comma dividing elements
/sxgc;
PTDEBUG && _d('Deserializing <', $string, '>');
die "Cannot deserialize an undefined string" unless defined $string;
push @escaped_parts, pos($string) ? substr( $string, pos($string) ) : $string;
my @parts;
foreach my $arg ( split(/(?<!\\),/, $string) ) {
if ( $arg eq '\N' ) {
$arg = undef;
}
else {
$arg =~ s/\\,/,/g;
$arg =~ s/\\\\N/\\N/g;
}
push @parts, $arg;
}
my @unescaped_parts = map {
my $part = $_;
if ( !@parts ) {
my $n_empty_strings = $string =~ tr/,//;
$n_empty_strings++;
PTDEBUG && _d($n_empty_strings, 'empty strings');
map { push @parts, '' } 1..$n_empty_strings;
}
elsif ( $string =~ m/(?<!\\),$/ ) {
PTDEBUG && _d('Last value is an empty string');
push @parts, '';
}
my $char_class = utf8::is_utf8($part) # If it's a UTF-8 string,
? qr/(?=\p{ASCII})\W/ # We only care about non-word
: qr/(?=\p{ASCII})\W|[\x{80}-\x{FF}]/; # Otherwise,
$part =~ s/\\($char_class)/$1/g;
$part;
} @escaped_parts;
PTDEBUG && _d('Deserialized', Dumper(\@parts));
return @parts;
}
return @unescaped_parts;
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";
}
1;

79
bin/pt-kill
View File

@@ -4323,6 +4323,11 @@ use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use Data::Dumper;
$Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Quotekeys = 0;
sub new {
my ( $class, %args ) = @_;
return bless {}, $class;
@@ -4387,44 +4392,64 @@ sub join_quote {
sub serialize_list {
my ( $self, @args ) = @_;
PTDEBUG && _d('Serializing', Dumper(\@args));
return unless @args;
return $args[0] if @args == 1 && !defined $args[0];
my @parts;
foreach my $arg ( @args ) {
if ( defined $arg ) {
$arg =~ s/,/\\,/g; # escape commas
$arg =~ s/\\N/\\\\N/g; # escape literal \N
push @parts, $arg;
}
else {
push @parts, '\N';
}
}
die "Cannot serialize multiple values with undef/NULL"
if grep { !defined $_ } @args;
return join ',', map { quotemeta } @args;
my $string = join(',', @parts);
PTDEBUG && _d('Serialized: <', $string, '>');
return $string;
}
sub deserialize_list {
my ( $self, $string ) = @_;
return $string unless defined $string;
my @escaped_parts = $string =~ /
\G # Start of string, or end of previous match.
( # Each of these is an element in the original list.
[^\\,]* # Anything not a backslash or a comma
(?: # When we get here, we found one of the above.
\\. # A backslash followed by something so we can continue
[^\\,]* # Same as above.
)* # Repeat zero of more times.
)
, # Comma dividing elements
/sxgc;
PTDEBUG && _d('Deserializing <', $string, '>');
die "Cannot deserialize an undefined string" unless defined $string;
push @escaped_parts, pos($string) ? substr( $string, pos($string) ) : $string;
my @parts;
foreach my $arg ( split(/(?<!\\),/, $string) ) {
if ( $arg eq '\N' ) {
$arg = undef;
}
else {
$arg =~ s/\\,/,/g;
$arg =~ s/\\\\N/\\N/g;
}
push @parts, $arg;
}
my @unescaped_parts = map {
my $part = $_;
if ( !@parts ) {
my $n_empty_strings = $string =~ tr/,//;
$n_empty_strings++;
PTDEBUG && _d($n_empty_strings, 'empty strings');
map { push @parts, '' } 1..$n_empty_strings;
}
elsif ( $string =~ m/(?<!\\),$/ ) {
PTDEBUG && _d('Last value is an empty string');
push @parts, '';
}
my $char_class = utf8::is_utf8($part) # If it's a UTF-8 string,
? qr/(?=\p{ASCII})\W/ # We only care about non-word
: qr/(?=\p{ASCII})\W|[\x{80}-\x{FF}]/; # Otherwise,
$part =~ s/\\($char_class)/$1/g;
$part;
} @escaped_parts;
PTDEBUG && _d('Deserialized', Dumper(\@parts));
return @parts;
}
return @unescaped_parts;
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";
}
1;

79
bin/pt-online-schema-change
View File

@@ -2942,6 +2942,11 @@ use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use Data::Dumper;
$Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Quotekeys = 0;
sub new {
my ( $class, %args ) = @_;
return bless {}, $class;
@@ -3006,44 +3011,64 @@ sub join_quote {
sub serialize_list {
my ( $self, @args ) = @_;
PTDEBUG && _d('Serializing', Dumper(\@args));
return unless @args;
return $args[0] if @args == 1 && !defined $args[0];
my @parts;
foreach my $arg ( @args ) {
if ( defined $arg ) {
$arg =~ s/,/\\,/g; # escape commas
$arg =~ s/\\N/\\\\N/g; # escape literal \N
push @parts, $arg;
}
else {
push @parts, '\N';
}
}
die "Cannot serialize multiple values with undef/NULL"
if grep { !defined $_ } @args;
return join ',', map { quotemeta } @args;
my $string = join(',', @parts);
PTDEBUG && _d('Serialized: <', $string, '>');
return $string;
}
sub deserialize_list {
my ( $self, $string ) = @_;
return $string unless defined $string;
my @escaped_parts = $string =~ /
\G # Start of string, or end of previous match.
( # Each of these is an element in the original list.
[^\\,]* # Anything not a backslash or a comma
(?: # When we get here, we found one of the above.
\\. # A backslash followed by something so we can continue
[^\\,]* # Same as above.
)* # Repeat zero of more times.
)
, # Comma dividing elements
/sxgc;
PTDEBUG && _d('Deserializing <', $string, '>');
die "Cannot deserialize an undefined string" unless defined $string;
push @escaped_parts, pos($string) ? substr( $string, pos($string) ) : $string;
my @parts;
foreach my $arg ( split(/(?<!\\),/, $string) ) {
if ( $arg eq '\N' ) {
$arg = undef;
}
else {
$arg =~ s/\\,/,/g;
$arg =~ s/\\\\N/\\N/g;
}
push @parts, $arg;
}
my @unescaped_parts = map {
my $part = $_;
if ( !@parts ) {
my $n_empty_strings = $string =~ tr/,//;
$n_empty_strings++;
PTDEBUG && _d($n_empty_strings, 'empty strings');
map { push @parts, '' } 1..$n_empty_strings;
}
elsif ( $string =~ m/(?<!\\),$/ ) {
PTDEBUG && _d('Last value is an empty string');
push @parts, '';
}
my $char_class = utf8::is_utf8($part) # If it's a UTF-8 string,
? qr/(?=\p{ASCII})\W/ # We only care about non-word
: qr/(?=\p{ASCII})\W|[\x{80}-\x{FF}]/; # Otherwise,
$part =~ s/\\($char_class)/$1/g;
$part;
} @escaped_parts;
PTDEBUG && _d('Deserialized', Dumper(\@parts));
return @parts;
}
return @unescaped_parts;
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";
}
1;

79
bin/pt-query-advisor
View File

@@ -2120,6 +2120,11 @@ use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use Data::Dumper;
$Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Quotekeys = 0;
sub new {
my ( $class, %args ) = @_;
return bless {}, $class;
@@ -2184,44 +2189,64 @@ sub join_quote {
sub serialize_list {
my ( $self, @args ) = @_;
PTDEBUG && _d('Serializing', Dumper(\@args));
return unless @args;
return $args[0] if @args == 1 && !defined $args[0];
my @parts;
foreach my $arg ( @args ) {
if ( defined $arg ) {
$arg =~ s/,/\\,/g; # escape commas
$arg =~ s/\\N/\\\\N/g; # escape literal \N
push @parts, $arg;
}
else {
push @parts, '\N';
}
}
die "Cannot serialize multiple values with undef/NULL"
if grep { !defined $_ } @args;
return join ',', map { quotemeta } @args;
my $string = join(',', @parts);
PTDEBUG && _d('Serialized: <', $string, '>');
return $string;
}
sub deserialize_list {
my ( $self, $string ) = @_;
return $string unless defined $string;
my @escaped_parts = $string =~ /
\G # Start of string, or end of previous match.
( # Each of these is an element in the original list.
[^\\,]* # Anything not a backslash or a comma
(?: # When we get here, we found one of the above.
\\. # A backslash followed by something so we can continue
[^\\,]* # Same as above.
)* # Repeat zero of more times.
)
, # Comma dividing elements
/sxgc;
PTDEBUG && _d('Deserializing <', $string, '>');
die "Cannot deserialize an undefined string" unless defined $string;
push @escaped_parts, pos($string) ? substr( $string, pos($string) ) : $string;
my @parts;
foreach my $arg ( split(/(?<!\\),/, $string) ) {
if ( $arg eq '\N' ) {
$arg = undef;
}
else {
$arg =~ s/\\,/,/g;
$arg =~ s/\\\\N/\\N/g;
}
push @parts, $arg;
}
my @unescaped_parts = map {
my $part = $_;
if ( !@parts ) {
my $n_empty_strings = $string =~ tr/,//;
$n_empty_strings++;
PTDEBUG && _d($n_empty_strings, 'empty strings');
map { push @parts, '' } 1..$n_empty_strings;
}
elsif ( $string =~ m/(?<!\\),$/ ) {
PTDEBUG && _d('Last value is an empty string');
push @parts, '';
}
my $char_class = utf8::is_utf8($part) # If it's a UTF-8 string,
? qr/(?=\p{ASCII})\W/ # We only care about non-word
: qr/(?=\p{ASCII})\W|[\x{80}-\x{FF}]/; # Otherwise,
$part =~ s/\\($char_class)/$1/g;
$part;
} @escaped_parts;
PTDEBUG && _d('Deserialized', Dumper(\@parts));
return @parts;
}
return @unescaped_parts;
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";
}
1;

79
bin/pt-query-digest
View File

@@ -1112,6 +1112,11 @@ use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use Data::Dumper;
$Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Quotekeys = 0;
sub new {
my ( $class, %args ) = @_;
return bless {}, $class;
@@ -1176,44 +1181,64 @@ sub join_quote {
sub serialize_list {
my ( $self, @args ) = @_;
PTDEBUG && _d('Serializing', Dumper(\@args));
return unless @args;
return $args[0] if @args == 1 && !defined $args[0];
my @parts;
foreach my $arg ( @args ) {
if ( defined $arg ) {
$arg =~ s/,/\\,/g; # escape commas
$arg =~ s/\\N/\\\\N/g; # escape literal \N
push @parts, $arg;
}
else {
push @parts, '\N';
}
}
die "Cannot serialize multiple values with undef/NULL"
if grep { !defined $_ } @args;
return join ',', map { quotemeta } @args;
my $string = join(',', @parts);
PTDEBUG && _d('Serialized: <', $string, '>');
return $string;
}
sub deserialize_list {
my ( $self, $string ) = @_;
return $string unless defined $string;
my @escaped_parts = $string =~ /
\G # Start of string, or end of previous match.
( # Each of these is an element in the original list.
[^\\,]* # Anything not a backslash or a comma
(?: # When we get here, we found one of the above.
\\. # A backslash followed by something so we can continue
[^\\,]* # Same as above.
)* # Repeat zero of more times.
)
, # Comma dividing elements
/sxgc;
PTDEBUG && _d('Deserializing <', $string, '>');
die "Cannot deserialize an undefined string" unless defined $string;
push @escaped_parts, pos($string) ? substr( $string, pos($string) ) : $string;
my @parts;
foreach my $arg ( split(/(?<!\\),/, $string) ) {
if ( $arg eq '\N' ) {
$arg = undef;
}
else {
$arg =~ s/\\,/,/g;
$arg =~ s/\\\\N/\\N/g;
}
push @parts, $arg;
}
my @unescaped_parts = map {
my $part = $_;
if ( !@parts ) {
my $n_empty_strings = $string =~ tr/,//;
$n_empty_strings++;
PTDEBUG && _d($n_empty_strings, 'empty strings');
map { push @parts, '' } 1..$n_empty_strings;
}
elsif ( $string =~ m/(?<!\\),$/ ) {
PTDEBUG && _d('Last value is an empty string');
push @parts, '';
}
my $char_class = utf8::is_utf8($part) # If it's a UTF-8 string,
? qr/(?=\p{ASCII})\W/ # We only care about non-word
: qr/(?=\p{ASCII})\W|[\x{80}-\x{FF}]/; # Otherwise,
$part =~ s/\\($char_class)/$1/g;
$part;
} @escaped_parts;
PTDEBUG && _d('Deserialized', Dumper(\@parts));
return @parts;
}
return @unescaped_parts;
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";
}
1;

79
bin/pt-slave-restart
View File

@@ -64,6 +64,11 @@ use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use Data::Dumper;
$Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Quotekeys = 0;
sub new {
my ( $class, %args ) = @_;
return bless {}, $class;
@@ -128,44 +133,64 @@ sub join_quote {
sub serialize_list {
my ( $self, @args ) = @_;
PTDEBUG && _d('Serializing', Dumper(\@args));
return unless @args;
return $args[0] if @args == 1 && !defined $args[0];
my @parts;
foreach my $arg ( @args ) {
if ( defined $arg ) {
$arg =~ s/,/\\,/g; # escape commas
$arg =~ s/\\N/\\\\N/g; # escape literal \N
push @parts, $arg;
}
else {
push @parts, '\N';
}
}
die "Cannot serialize multiple values with undef/NULL"
if grep { !defined $_ } @args;
return join ',', map { quotemeta } @args;
my $string = join(',', @parts);
PTDEBUG && _d('Serialized: <', $string, '>');
return $string;
}
sub deserialize_list {
my ( $self, $string ) = @_;
return $string unless defined $string;
my @escaped_parts = $string =~ /
\G # Start of string, or end of previous match.
( # Each of these is an element in the original list.
[^\\,]* # Anything not a backslash or a comma
(?: # When we get here, we found one of the above.
\\. # A backslash followed by something so we can continue
[^\\,]* # Same as above.
)* # Repeat zero of more times.
)
, # Comma dividing elements
/sxgc;
PTDEBUG && _d('Deserializing <', $string, '>');
die "Cannot deserialize an undefined string" unless defined $string;
push @escaped_parts, pos($string) ? substr( $string, pos($string) ) : $string;
my @parts;
foreach my $arg ( split(/(?<!\\),/, $string) ) {
if ( $arg eq '\N' ) {
$arg = undef;
}
else {
$arg =~ s/\\,/,/g;
$arg =~ s/\\\\N/\\N/g;
}
push @parts, $arg;
}
my @unescaped_parts = map {
my $part = $_;
if ( !@parts ) {
my $n_empty_strings = $string =~ tr/,//;
$n_empty_strings++;
PTDEBUG && _d($n_empty_strings, 'empty strings');
map { push @parts, '' } 1..$n_empty_strings;
}
elsif ( $string =~ m/(?<!\\),$/ ) {
PTDEBUG && _d('Last value is an empty string');
push @parts, '';
}
my $char_class = utf8::is_utf8($part) # If it's a UTF-8 string,
? qr/(?=\p{ASCII})\W/ # We only care about non-word
: qr/(?=\p{ASCII})\W|[\x{80}-\x{FF}]/; # Otherwise,
$part =~ s/\\($char_class)/$1/g;
$part;
} @escaped_parts;
PTDEBUG && _d('Deserialized', Dumper(\@parts));
return @parts;
}
return @unescaped_parts;
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";
}
1;

79
bin/pt-table-checksum
View File

@@ -3603,6 +3603,11 @@ use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use Data::Dumper;
$Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Quotekeys = 0;
sub new {
my ( $class, %args ) = @_;
return bless {}, $class;
@@ -3667,44 +3672,64 @@ sub join_quote {
sub serialize_list {
my ( $self, @args ) = @_;
PTDEBUG && _d('Serializing', Dumper(\@args));
return unless @args;
return $args[0] if @args == 1 && !defined $args[0];
my @parts;
foreach my $arg ( @args ) {
if ( defined $arg ) {
$arg =~ s/,/\\,/g; # escape commas
$arg =~ s/\\N/\\\\N/g; # escape literal \N
push @parts, $arg;
}
else {
push @parts, '\N';
}
}
die "Cannot serialize multiple values with undef/NULL"
if grep { !defined $_ } @args;
return join ',', map { quotemeta } @args;
my $string = join(',', @parts);
PTDEBUG && _d('Serialized: <', $string, '>');
return $string;
}
sub deserialize_list {
my ( $self, $string ) = @_;
return $string unless defined $string;
my @escaped_parts = $string =~ /
\G # Start of string, or end of previous match.
( # Each of these is an element in the original list.
[^\\,]* # Anything not a backslash or a comma
(?: # When we get here, we found one of the above.
\\. # A backslash followed by something so we can continue
[^\\,]* # Same as above.
)* # Repeat zero of more times.
)
, # Comma dividing elements
/sxgc;
PTDEBUG && _d('Deserializing <', $string, '>');
die "Cannot deserialize an undefined string" unless defined $string;
push @escaped_parts, pos($string) ? substr( $string, pos($string) ) : $string;
my @parts;
foreach my $arg ( split(/(?<!\\),/, $string) ) {
if ( $arg eq '\N' ) {
$arg = undef;
}
else {
$arg =~ s/\\,/,/g;
$arg =~ s/\\\\N/\\N/g;
}
push @parts, $arg;
}
my @unescaped_parts = map {
my $part = $_;
if ( !@parts ) {
my $n_empty_strings = $string =~ tr/,//;
$n_empty_strings++;
PTDEBUG && _d($n_empty_strings, 'empty strings');
map { push @parts, '' } 1..$n_empty_strings;
}
elsif ( $string =~ m/(?<!\\),$/ ) {
PTDEBUG && _d('Last value is an empty string');
push @parts, '';
}
my $char_class = utf8::is_utf8($part) # If it's a UTF-8 string,
? qr/(?=\p{ASCII})\W/ # We only care about non-word
: qr/(?=\p{ASCII})\W|[\x{80}-\x{FF}]/; # Otherwise,
$part =~ s/\\($char_class)/$1/g;
$part;
} @escaped_parts;
PTDEBUG && _d('Deserialized', Dumper(\@parts));
return @parts;
}
return @unescaped_parts;
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";
}
1;

79
bin/pt-table-sync
View File

@@ -1747,6 +1747,11 @@ use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use Data::Dumper;
$Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Quotekeys = 0;
sub new {
my ( $class, %args ) = @_;
return bless {}, $class;
@@ -1811,44 +1816,64 @@ sub join_quote {
sub serialize_list {
my ( $self, @args ) = @_;
PTDEBUG && _d('Serializing', Dumper(\@args));
return unless @args;
return $args[0] if @args == 1 && !defined $args[0];
my @parts;
foreach my $arg ( @args ) {
if ( defined $arg ) {
$arg =~ s/,/\\,/g; # escape commas
$arg =~ s/\\N/\\\\N/g; # escape literal \N
push @parts, $arg;
}
else {
push @parts, '\N';
}
}
die "Cannot serialize multiple values with undef/NULL"
if grep { !defined $_ } @args;
return join ',', map { quotemeta } @args;
my $string = join(',', @parts);
PTDEBUG && _d('Serialized: <', $string, '>');
return $string;
}
sub deserialize_list {
my ( $self, $string ) = @_;
return $string unless defined $string;
my @escaped_parts = $string =~ /
\G # Start of string, or end of previous match.
( # Each of these is an element in the original list.
[^\\,]* # Anything not a backslash or a comma
(?: # When we get here, we found one of the above.
\\. # A backslash followed by something so we can continue
[^\\,]* # Same as above.
)* # Repeat zero of more times.
)
, # Comma dividing elements
/sxgc;
PTDEBUG && _d('Deserializing <', $string, '>');
die "Cannot deserialize an undefined string" unless defined $string;
push @escaped_parts, pos($string) ? substr( $string, pos($string) ) : $string;
my @parts;
foreach my $arg ( split(/(?<!\\),/, $string) ) {
if ( $arg eq '\N' ) {
$arg = undef;
}
else {
$arg =~ s/\\,/,/g;
$arg =~ s/\\\\N/\\N/g;
}
push @parts, $arg;
}
my @unescaped_parts = map {
my $part = $_;
if ( !@parts ) {
my $n_empty_strings = $string =~ tr/,//;
$n_empty_strings++;
PTDEBUG && _d($n_empty_strings, 'empty strings');
map { push @parts, '' } 1..$n_empty_strings;
}
elsif ( $string =~ m/(?<!\\),$/ ) {
PTDEBUG && _d('Last value is an empty string');
push @parts, '';
}
my $char_class = utf8::is_utf8($part) # If it's a UTF-8 string,
? qr/(?=\p{ASCII})\W/ # We only care about non-word
: qr/(?=\p{ASCII})\W|[\x{80}-\x{FF}]/; # Otherwise,
$part =~ s/\\($char_class)/$1/g;
$part;
} @escaped_parts;
PTDEBUG && _d('Deserialized', Dumper(\@parts));
return @parts;
}
return @unescaped_parts;
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";
}
1;

111
bin/pt-table-usage
View File

@@ -298,18 +298,6 @@ sub get_dbh {
die "Error getting the current SQL_MODE: $EVAL_ERROR";
}
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
. ($sql_mode ? ",$sql_mode" : '')
. '\'*/';
PTDEBUG && _d($dbh, $sql);
eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) {
die "Error setting SQL_QUOTE_SHOW_CREATE, SQL_MODE"
. ($sql_mode ? " and $sql_mode" : '')
. ": $EVAL_ERROR";
}
if ( my ($charset) = $cxn_string =~ m/charset=([\w]+)/ ) {
$sql = qq{/*!40101 SET NAMES "$charset"*/};
PTDEBUG && _d($dbh, ':', $sql);
@@ -335,6 +323,18 @@ sub get_dbh {
die "Error setting $var: $EVAL_ERROR";
}
}
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
. ($sql_mode ? ",$sql_mode" : '')
. '\'*/';
PTDEBUG && _d($dbh, $sql);
eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) {
die "Error setting SQL_QUOTE_SHOW_CREATE, SQL_MODE"
. ($sql_mode ? " and $sql_mode" : '')
. ": $EVAL_ERROR";
}
}
PTDEBUG && _d('DBH info: ',
@@ -5515,6 +5515,11 @@ use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use Data::Dumper;
$Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Quotekeys = 0;
sub new {
my ( $class, %args ) = @_;
return bless {}, $class;
@@ -5542,12 +5547,18 @@ sub quote_val {
sub split_unquote {
my ( $self, $db_tbl, $default_db ) = @_;
$db_tbl =~ s/`//g;
my ( $db, $tbl ) = split(/[.]/, $db_tbl);
if ( !$tbl ) {
$tbl = $db;
$db = $default_db;
}
for ($db, $tbl) {
next unless $_;
s/\A`//;
s/`\z//;
s/``/`/g;
}
return ($db, $tbl);
}
@@ -5573,44 +5584,64 @@ sub join_quote {
sub serialize_list {
my ( $self, @args ) = @_;
PTDEBUG && _d('Serializing', Dumper(\@args));
return unless @args;
return $args[0] if @args == 1 && !defined $args[0];
my @parts;
foreach my $arg ( @args ) {
if ( defined $arg ) {
$arg =~ s/,/\\,/g; # escape commas
$arg =~ s/\\N/\\\\N/g; # escape literal \N
push @parts, $arg;
}
else {
push @parts, '\N';
}
}
die "Cannot serialize multiple values with undef/NULL"
if grep { !defined $_ } @args;
return join ',', map { quotemeta } @args;
my $string = join(',', @parts);
PTDEBUG && _d('Serialized: <', $string, '>');
return $string;
}
sub deserialize_list {
my ( $self, $string ) = @_;
return $string unless defined $string;
my @escaped_parts = $string =~ /
\G # Start of string, or end of previous match.
( # Each of these is an element in the original list.
[^\\,]* # Anything not a backslash or a comma
(?: # When we get here, we found one of the above.
\\. # A backslash followed by something so we can continue
[^\\,]* # Same as above.
)* # Repeat zero of more times.
)
, # Comma dividing elements
/sxgc;
PTDEBUG && _d('Deserializing <', $string, '>');
die "Cannot deserialize an undefined string" unless defined $string;
push @escaped_parts, pos($string) ? substr( $string, pos($string) ) : $string;
my @parts;
foreach my $arg ( split(/(?<!\\),/, $string) ) {
if ( $arg eq '\N' ) {
$arg = undef;
}
else {
$arg =~ s/\\,/,/g;
$arg =~ s/\\\\N/\\N/g;
}
push @parts, $arg;
}
my @unescaped_parts = map {
my $part = $_;
if ( !@parts ) {
my $n_empty_strings = $string =~ tr/,//;
$n_empty_strings++;
PTDEBUG && _d($n_empty_strings, 'empty strings');
map { push @parts, '' } 1..$n_empty_strings;
}
elsif ( $string =~ m/(?<!\\),$/ ) {
PTDEBUG && _d('Last value is an empty string');
push @parts, '';
}
my $char_class = utf8::is_utf8($part) # If it's a UTF-8 string,
? qr/(?=\p{ASCII})\W/ # We only care about non-word
: qr/(?=\p{ASCII})\W|[\x{80}-\x{FF}]/; # Otherwise,
$part =~ s/\\($char_class)/$1/g;
$part;
} @escaped_parts;
PTDEBUG && _d('Deserialized', Dumper(\@parts));
return @parts;
}
return @unescaped_parts;
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";
}
1;

79
bin/pt-upgrade
View File

@@ -1518,6 +1518,11 @@ use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use Data::Dumper;
$Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Quotekeys = 0;
sub new {
my ( $class, %args ) = @_;
return bless {}, $class;
@@ -1582,44 +1587,64 @@ sub join_quote {
sub serialize_list {
my ( $self, @args ) = @_;
PTDEBUG && _d('Serializing', Dumper(\@args));
return unless @args;
return $args[0] if @args == 1 && !defined $args[0];
my @parts;
foreach my $arg ( @args ) {
if ( defined $arg ) {
$arg =~ s/,/\\,/g; # escape commas
$arg =~ s/\\N/\\\\N/g; # escape literal \N
push @parts, $arg;
}
else {
push @parts, '\N';
}
}
die "Cannot serialize multiple values with undef/NULL"
if grep { !defined $_ } @args;
return join ',', map { quotemeta } @args;
my $string = join(',', @parts);
PTDEBUG && _d('Serialized: <', $string, '>');
return $string;
}
sub deserialize_list {
my ( $self, $string ) = @_;
return $string unless defined $string;
my @escaped_parts = $string =~ /
\G # Start of string, or end of previous match.
( # Each of these is an element in the original list.
[^\\,]* # Anything not a backslash or a comma
(?: # When we get here, we found one of the above.
\\. # A backslash followed by something so we can continue
[^\\,]* # Same as above.
)* # Repeat zero of more times.
)
, # Comma dividing elements
/sxgc;
PTDEBUG && _d('Deserializing <', $string, '>');
die "Cannot deserialize an undefined string" unless defined $string;
push @escaped_parts, pos($string) ? substr( $string, pos($string) ) : $string;
my @parts;
foreach my $arg ( split(/(?<!\\),/, $string) ) {
if ( $arg eq '\N' ) {
$arg = undef;
}
else {
$arg =~ s/\\,/,/g;
$arg =~ s/\\\\N/\\N/g;
}
push @parts, $arg;
}
my @unescaped_parts = map {
my $part = $_;
if ( !@parts ) {
my $n_empty_strings = $string =~ tr/,//;
$n_empty_strings++;
PTDEBUG && _d($n_empty_strings, 'empty strings');
map { push @parts, '' } 1..$n_empty_strings;
}
elsif ( $string =~ m/(?<!\\),$/ ) {
PTDEBUG && _d('Last value is an empty string');
push @parts, '';
}
my $char_class = utf8::is_utf8($part) # If it's a UTF-8 string,
? qr/(?=\p{ASCII})\W/ # We only care about non-word
: qr/(?=\p{ASCII})\W|[\x{80}-\x{FF}]/; # Otherwise,
$part =~ s/\\($char_class)/$1/g;
$part;
} @escaped_parts;
PTDEBUG && _d('Deserialized', Dumper(\@parts));
return @parts;
}
return @unescaped_parts;
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";
}
1;

24
bin/pt-visual-explain
View File

@@ -1986,18 +1986,6 @@ sub get_dbh {
die "Error getting the current SQL_MODE: $EVAL_ERROR";
}
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
. ($sql_mode ? ",$sql_mode" : '')
. '\'*/';
PTDEBUG && _d($dbh, $sql);
eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) {
die "Error setting SQL_QUOTE_SHOW_CREATE, SQL_MODE"
. ($sql_mode ? " and $sql_mode" : '')
. ": $EVAL_ERROR";
}
if ( my ($charset) = $cxn_string =~ m/charset=([\w]+)/ ) {
$sql = qq{/*!40101 SET NAMES "$charset"*/};
PTDEBUG && _d($dbh, ':', $sql);
@@ -2023,6 +2011,18 @@ sub get_dbh {
die "Error setting $var: $EVAL_ERROR";
}
}
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
. ($sql_mode ? ",$sql_mode" : '')
. '\'*/';
PTDEBUG && _d($dbh, $sql);
eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) {
die "Error setting SQL_QUOTE_SHOW_CREATE, SQL_MODE"
. ($sql_mode ? " and $sql_mode" : '')
. ": $EVAL_ERROR";
}
}
PTDEBUG && _d('DBH info: ',

4
lib/DSNParser.pm
View File

@@ -1,5 +1,5 @@
# This program is copyright 2007-2011 Baron Schwartz, 2011 Percona Ireland Ltd.
# Feedback and improvements are welcome.
# This program is copyright 2007-2011 Baron Schwartz,
# 2011-2013 Percona Ireland Ltd.
#
# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF

104
lib/Quoter.pm
View File

@@ -27,6 +27,11 @@ use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use Data::Dumper;
$Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Quotekeys = 0;
# Sub: new
#
# Parameters:
@@ -155,68 +160,65 @@ sub join_quote {
# and the results concatenated with ','.
sub serialize_list {
my ( $self, @args ) = @_;
PTDEBUG && _d('Serializing', Dumper(\@args));
return unless @args;
# If the only value is undef, which is NULL for MySQL, then return
# the same. undef/NULL is a valid boundary value, however...
return $args[0] if @args == 1 && !defined $args[0];
my @parts;
foreach my $arg ( @args ) {
if ( defined $arg ) {
$arg =~ s/,/\\,/g; # escape commas
$arg =~ s/\\N/\\\\N/g; # escape literal \N
push @parts, $arg;
}
else {
push @parts, '\N';
}
}
# ... if there's an undef/NULL value and more than one value,
# then we have no easy way to serialize the values into a list.
# We can't convert undef to "NULL" because "NULL" is a valid
# value itself, and we can't make it "" because a blank string
# is also a valid value. In practice, a boundary value with
# two NULL values should be rare.
die "Cannot serialize multiple values with undef/NULL"
if grep { !defined $_ } @args;
return join ',', map { quotemeta } @args;
my $string = join(',', @parts);
PTDEBUG && _d('Serialized: <', $string, '>');
return $string;
}
sub deserialize_list {
my ( $self, $string ) = @_;
return $string unless defined $string;
my @escaped_parts = $string =~ /
\G # Start of string, or end of previous match.
( # Each of these is an element in the original list.
[^\\,]* # Anything not a backslash or a comma
(?: # When we get here, we found one of the above.
\\. # A backslash followed by something so we can continue
[^\\,]* # Same as above.
)* # Repeat zero of more times.
)
, # Comma dividing elements
/sxgc;
PTDEBUG && _d('Deserializing <', $string, '>');
die "Cannot deserialize an undefined string" unless defined $string;
# Grab the rest of the string following the last match.
# If there wasn't a last match, like for a single-element list,
# the entire string represents the single element, so grab that.
push @escaped_parts, pos($string) ? substr( $string, pos($string) ) : $string;
my @parts;
foreach my $arg ( split(/(?<!\\),/, $string) ) {
if ( $arg eq '\N' ) {
$arg = undef;
}
else {
$arg =~ s/\\,/,/g;
$arg =~ s/\\\\N/\\N/g;
}
push @parts, $arg;
}
# Undo the quotemeta().
my @unescaped_parts = map {
my $part = $_;
# Here be weirdness. Unfortunately quotemeta() is broken, and exposes
# the internal representation of scalars. Namely, the latin-1 range,
# \128-\377 (\p{Latin1} in newer Perls) is all escaped in downgraded
# strings, but left alone in UTF-8 strings. Thus, this.
if ( !@parts ) {
# Perl split() won't split ",,", so handle it manually.
my $n_empty_strings = $string =~ tr/,//;
$n_empty_strings++;
PTDEBUG && _d($n_empty_strings, 'empty strings');
map { push @parts, '' } 1..$n_empty_strings;
}
elsif ( $string =~ m/(?<!\\),$/ ) {
PTDEBUG && _d('Last value is an empty string');
push @parts, '';
}
# TODO: quotemeta() might change in 5.16 to mean
# qr/(?=\p{ASCII})\W|\p{Pattern_Syntax}/
# And also fix this whole weird behavior under
# use feature 'unicode_strings' -- If/once that's
# implemented, this will have to change.
my $char_class = utf8::is_utf8($part) # If it's a UTF-8 string,
? qr/(?=\p{ASCII})\W/ # We only care about non-word
# characters in the ASCII range
: qr/(?=\p{ASCII})\W|[\x{80}-\x{FF}]/; # Otherwise,
# same as above, but also
# unescape the latin-1 range.
$part =~ s/\\($char_class)/$1/g;
$part;
} @escaped_parts;
PTDEBUG && _d('Deserialized', Dumper(\@parts));
return @parts;
}
return @unescaped_parts;
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";
}
1;

3
lib/Sandbox.pm
View File

@@ -358,7 +358,8 @@ sub verify_test_data {
'SELECT * FROM percona_test.checksums',
'db_tbl');
$self->{checksum_ref} = $ref unless $self->{checksum_ref};
my @tables_in_mysql = grep { !/^innodb_(?:table|index)_stats$/ }
my @tables_in_mysql = grep { !/^(?:innodb|slave)_/ }
grep { !/_log$/ }
@{$master->selectcol_arrayref('SHOW TABLES FROM mysql')};
my @tables_in_sakila = qw(actor address category city country customer
film film_actor film_category film_text inventory

6
sandbox/load-sakila-db
View File

@@ -33,4 +33,8 @@ if [ ! -d "$PERCONA_TOOLKIT_BRANCH" ]; then
fi
/tmp/$PORT/use < $PERCONA_TOOLKIT_BRANCH/sandbox/sakila.sql
exit $?
exit_status=$?
/tmp/$PORT/use sakila -e "ANALYZE TABLE actor, address, category, city, country, customer, film, film_actor, film_category, film_text, inventory, language, payment, rental, staff, store" >/dev/null
exit $exit_status

BIN
sandbox/servers/5.6/data.tar.gz
View File

Binary file not shown.

217
t/lib/Quoter.t
View File

@@ -10,9 +10,15 @@ use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use Test::More;
use Data::Dumper;
use Quoter;
use PerconaTest;
use DSNParser;
use Sandbox;
my $dp = new DSNParser(opts=>$dsn_opts);
my $sb = new Sandbox(basedir => '/tmp', DSNParser => $dp);
my $dbh = $sb->get_dbh_for('master');
my $q = new Quoter;
@@ -95,14 +101,14 @@ is_deeply(
'splits with a quoted db.tbl ad embedded quotes',
);
TODO: {
local $::TODO = "Embedded periods not yet supported";
is_deeply(
[$q->split_unquote("`d.b`.`tbl`")],
[qw(d.b tbl)],
'splits with embedded periods: `d.b`.`tbl`',
);
}
#TODO: {
# local $::TODO = "Embedded periods not yet supported";
# is_deeply(
# [$q->split_unquote("`d.b`.`tbl`")],
# [qw(d.b tbl)],
# 'splits with embedded periods: `d.b`.`tbl`',
# );
#}
is( $q->literal_like('foo'), "'foo'", 'LIKE foo');
is( $q->literal_like('foo_bar'), "'foo\\_bar'", 'LIKE foo_bar');
@@ -121,120 +127,137 @@ is( $q->join_quote('`db`', '`foo`.`tbl`'), '`foo`.`tbl`', 'join_merge(`db`, `foo
# ###########################################################################
is(
$q->serialize_list(),
$q->serialize_list( () ),
undef,
"Serialize empty list"
'Serialize empty list returns undef'
);
binmode(STDOUT, ':utf8')
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
binmode(STDERR, ':utf8')
or die "Can't binmode(STDERR, ':utf8'): $OS_ERROR";
is(
$q->serialize_list(''),
'',
"Serialize 1 empty string",
);
# Prevent "Wide character in print at Test/Builder.pm" warnings.
binmode Test::More->builder->$_(), ':encoding(UTF-8)'
for qw(output failure_output);
is(
$q->serialize_list('', '', ''),
',,',
"Serialize 3 empty strings",
);
is(
$q->serialize_list(undef),
undef,
"Serialize undef string",
);
is(
$q->deserialize_list(undef),
undef,
"Deserialize undef string",
);
my @serialize_tests = (
my @latin1_serialize_tests = (
[ 'a' ],
[ 'a', 'b', ],
[ 'a,', 'b', ],
[ "a,\\\nc\nas", 'b', ],
[ 'a\\\,a', 'c', ],
[ 'a\\\\,a', 'c', ],
[ 'a\\\\\,aa', 'c', ],
[ 'a\\\\\\,aa', 'c', ],
[ 'a\\\,a,a', 'c,d,e,d,', ],
[ "\\\,\x{e8},a", '!!!!__!*`,`\\', ], # Latin-1
[ "\x{30cb}\\\,\x{e8},a", '!!!!__!*`,`\\', ], # UTF-8
[ ",,,,,,,,,,,,,,", ",", ],
[ "\\,\\,\\,\\,\\,\\,\\,\\,\\,\\,\\,,,,\\", ":(", ],
[ "asdfa", "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\,a", ],
[ 'a,', 'b', ], # trailing comma
[ ',a', 'b', ], # leading comma
[ 'a', ',b' ],
[ 0 ],
[ 0, 0 ],
[ 1, 2 ],
[ 7, 9 ],
[ '' ], # emptry string
[ '', '', '', ],
[ '' ],
[ undef ],
[ undef ], # NULL
[ undef, undef ],
[ undef, '' ],
[ '\N' ], # literal \N
[ "un caf\x{e9} na\x{ef}ve" ], # Latin-1
[ "\\," ],
[ '\\' ],
[ q/"abc\\", 'def'/ ], # Brian's pathalogical case
);
use DSNParser;
use Sandbox;
my $dp = new DSNParser(opts=>$dsn_opts);
my $sb = new Sandbox(basedir => '/tmp', DSNParser => $dp);
my $dbh = $sb->get_dbh_for('master');
SKIP: {
skip 'Cannot connect to sandbox master', scalar @serialize_tests unless $dbh;
my @utf8_serialize_tests = (
[ "\x{30cb} \x{e8}" ], # UTF-8
);
# Prevent "Wide character in print at Test/Builder.pm" warnings.
binmode Test::More->builder->$_(), ':encoding(UTF-8)'
for qw(output failure_output);
SKIP: {
skip 'Cannot connect to sandbox master', scalar @latin1_serialize_tests
unless $dbh;
$dbh->do('CREATE DATABASE IF NOT EXISTS serialize_test');
$dbh->do('DROP TABLE IF EXISTS serialize_test.serialize');
$dbh->do('CREATE TABLE serialize_test.serialize (id INT, foo TEXT)');
$dbh->do('CREATE TABLE serialize_test.serialize (id INT, textval TEXT, blobval BLOB)');
my $sth = $dbh->prepare(
"INSERT INTO serialize_test.serialize (id, foo) VALUES (?, ?)"
);
my $selsth = $dbh->prepare(
"SELECT foo FROM serialize_test.serialize WHERE id=? LIMIT 1"
my $sth = $dbh->prepare(
"INSERT INTO serialize_test.serialize VALUES (?, ?, ?)"
);
for my $test_index ( 0..$#serialize_tests ) {
my $ser = $q->serialize_list( @{$serialize_tests[$test_index]} );
for my $test_index ( 0..$#latin1_serialize_tests ) {
# Bit of a hack, but we want to test both of Perl's internal encodings
# for correctness.
local $dbh->{'mysql_enable_utf8'} = 1 if utf8::is_utf8($ser);
$sth->execute($test_index, $ser);
$selsth->execute($test_index);
my $flat_string = "["
. join( "][",
map { defined($_) ? $_ : '' } @{$serialize_tests[$test_index]}
)
. "]";
# Flat, friendly name for the test string
my $flat_string
= "["
. join( "][",
map { defined($_) ? $_ : 'undef' }
@{$latin1_serialize_tests[$test_index]})
. "]";
$flat_string =~ s/\n/\\n/g;
# diag($test_index);
SKIP: {
skip "DBD::mysql version $DBD::mysql::VERSION has utf8 bugs. "
. "See https://bugs.launchpad.net/percona-toolkit/+bug/932327",
1 if $DBD::mysql::VERSION lt '4' && $test_index == 9;
is_deeply(
[ $q->deserialize_list($selsth->fetchrow_array()) ],
$serialize_tests[$test_index],
"Serialize $flat_string"
);
}
# INSERT the serialized list of values.
my $ser = $q->serialize_list( @{$latin1_serialize_tests[$test_index]} );
$sth->execute($test_index, $ser, $ser);
# SELECT back the values and deserialize them.
my ($text_string) = $dbh->selectrow_array(
"SELECT textval FROM serialize_test.serialize WHERE id=$test_index");
my @text_parts = $q->deserialize_list($text_string);
is_deeply(
\@text_parts,
$latin1_serialize_tests[$test_index],
"Serialize $flat_string"
) or diag(Dumper($text_string, \@text_parts));
}
};
my $utf8_dbh = $sb->get_dbh_for('master');
$utf8_dbh->{mysql_enable_utf8} = 1;
$utf8_dbh->do("SET NAMES 'utf8'");
SKIP: {
skip 'Cannot connect to sandbox master', scalar @utf8_serialize_tests
unless $utf8_dbh;
skip 'DBD::mysql 3.0007 has UTF-8 bug', scalar @utf8_serialize_tests
if $DBD::mysql::VERSION le '3.0007';
$utf8_dbh->do("DROP TABLE serialize_test.serialize");
$utf8_dbh->do("CREATE TABLE serialize_test.serialize (id INT, textval TEXT, blobval BLOB) CHARSET='utf8'");
my $sth = $utf8_dbh->prepare(
"INSERT INTO serialize_test.serialize VALUES (?, ?, ?)"
);
for my $test_index ( 0..$#utf8_serialize_tests ) {
# Flat, friendly name for the test string
my $flat_string
= "["
. join( "][",
map { defined($_) ? $_ : 'undef' }
@{$utf8_serialize_tests[$test_index]})
. "]";
$flat_string =~ s/\n/\\n/g;
# INSERT the serialized list of values.
my $ser = $q->serialize_list( @{$utf8_serialize_tests[$test_index]} );
$sth->execute($test_index, $ser, $ser);
# SELECT back the values and deserialize them.
my ($text_string) = $utf8_dbh->selectrow_array(
"SELECT textval FROM serialize_test.serialize WHERE id=$test_index");
my @text_parts = $q->deserialize_list($text_string);
is_deeply(
\@text_parts,
$utf8_serialize_tests[$test_index],
"Serialize UTF-8 $flat_string"
) or diag(Dumper($text_string, \@text_parts));
}
$sth->finish();
$selsth->finish();
$dbh->do("DROP DATABASE serialize_test");
$sb->wipe_clean($dbh);
$dbh->disconnect();
$utf8_dbh->disconnect();
};
# ###########################################################################
# Done.
# ###########################################################################
if ( $dbh ) {
$sb->wipe_clean($dbh);
$dbh->disconnect();
}
ok($sb->ok(), "Sandbox servers") or BAIL_OUT(__FILE__ . " broke the sandbox");
done_testing;

9
t/pt-online-schema-change/skip_innodb.t
View File

@@ -15,6 +15,10 @@ use PerconaTest;
use Sandbox;
require "$trunk/bin/pt-online-schema-change";
if ( $sandbox_version ge '5.6' ) {
plan skip_all => 'Cannot disable InnoDB in MySQL 5.6';
}
diag(`$trunk/sandbox/stop-sandbox 12348 >/dev/null`);
diag(`SKIP_INNODB=1 $trunk/sandbox/start-sandbox master 12348 >/dev/null`);
@@ -25,9 +29,6 @@ my $master_dbh = $sb->get_dbh_for('master1');
if ( !$master_dbh ) {
plan skip_all => 'Cannot connect to sandbox master 12348';
}
else {
plan tests => 3;
}
my $master_dsn = 'h=127.1,P=12348,u=msandbox,p=msandbox';
my @args = (qw(--lock-wait-timeout 3), '--max-load', '');
@@ -55,4 +56,4 @@ is(
# #############################################################################
diag(`$trunk/sandbox/stop-sandbox 12348 >/dev/null`);
ok($sb->ok(), "Sandbox servers") or BAIL_OUT(__FILE__ . " broke the sandbox");
exit;
done_testing;

84
t/pt-table-checksum/basics.t
View File

@@ -79,10 +79,10 @@ ok(
# Since this varies by default, there's no use checking the checksums
# other than to ensure that there's at one for each table.
$row = $master_dbh->selectrow_arrayref("select count(*) from percona.checksums");
cmp_ok(
$row->[0], '>=', ($sandbox_version gt "5.0" ? 37 : 33),
'At least 37 checksums'
);
ok(
$row->[0] > 30 && $row->[0] < 50,
'Between 30 and 50 chunks'
) or diag($row->[0]);
# ############################################################################
# Static chunk size (disable --chunk-time)
@@ -97,24 +97,18 @@ ok(
"Static chunk size (--chunk-time 0)"
);
my $n_checksums = $sandbox_version eq "5.6" ? 89
: $sandbox_version eq "5.5" ? 90
: $sandbox_version eq "5.1" ? 89
: 85;
$row = $master_dbh->selectrow_arrayref("select count(*) from percona.checksums");
is(
$row->[0],
$n_checksums,
'Expected checksums on master'
);
ok(
$row->[0] >= 85 && $row->[0] <= 90,
'Between 85 and 90 chunks on master'
) or diag($row->[0]);
$row = $slave1_dbh->selectrow_arrayref("select count(*) from percona.checksums");
my $row2 = $slave1_dbh->selectrow_arrayref("select count(*) from percona.checksums");
is(
$row2->[0],
$row->[0],
$n_checksums,
'Expected checksums on slave'
);
'... same number of chunks on slave'
) or diag($row->[0], ' ', $row2->[0]);
# ############################################################################
# --[no]replicate-check and, implicitly, the tool's exit status.
@@ -361,11 +355,10 @@ $output = output(
stderr => 1,
);
# Before 2.2 the exit status was 0, but bug 1087804 changed this to 1.
is(
$exit_status,
1,
"No host in DSN, non-zero exit status"
0,
"No host in DSN, zero exit status"
);
is(
@@ -491,55 +484,6 @@ is(
"Bug 821675 (dot): 0 errors"
);
# #############################################################################
# Bug 1087804: pt-table-checksum doesn't warn if no slaves are found
# #############################################################################
$sb->load_file('master', "$sample/dsn-table.sql");
$master_dbh->do('TRUNCATE TABLE dsns.dsns');
$sb->wait_for_slaves;
my $slave1_dsn = $sb->dsn_for('slave1');
$output = output(
sub { $exit_status = pt_table_checksum::main(@args,
qw(-t sakila.country),
"--recursion-method", "dsn=$slave1_dsn,t=dsns.dsns")
},
stderr => 1,
);
like(
$output,
qr/no slaves were found/,
"Warns if no slaves are found"
);
is(
$exit_status,
1,
'...exit status 1'
);
$output = output(
sub { $exit_status = pt_table_checksum::main(@args,
qw(-t sakila.country),
"--recursion-method", "none")
},
stderr => 1,
);
unlike(
$output,
qr/no slaves were found/,
"No warning if no slaves and --recursion-method=none"
);
is(
$exit_status,
0,
'...exit status 0'
);
# #############################################################################
# Done.
# #############################################################################

5
t/pt-table-checksum/bugs.t
View File

@@ -195,7 +195,7 @@ is(
# #############################################################################
($output) = output(
sub { pt_table_checksum::main(@args, '--tables', 'mysql.user,mysql.host',
sub { pt_table_checksum::main(@args, '--tables', 'mysql.user,mysql.db',
'--columns', 'some_fale_column') },
stderr => 1,
);
@@ -269,7 +269,7 @@ SKIP: {
"...and warns for both level 1 and level 2 slaves"
) or diag($output);
diag(`$trunk/sandbox/stop-sandbox 12348 12349`);
diag(`$trunk/sandbox/stop-sandbox 12349 12348`);
}
# #############################################################################
@@ -278,4 +278,3 @@ SKIP: {
$sb->wipe_clean($master_dbh);
ok($sb->ok(), "Sandbox servers") or BAIL_OUT(__FILE__ . " broke the sandbox");
done_testing;
exit;

2
t/pt-table-checksum/char_chunking.t
View File

@@ -73,7 +73,7 @@ is_deeply(
$row = $master_dbh->selectrow_arrayref("select lower_boundary, upper_boundary from percona.checksums where db='test' and tbl='ascii' and chunk=10");
is_deeply(
$row,
[ 'ZESUS\!\!\!', undef ],
[ 'ZESUS!!!', undef ],
"Upper oob boundary"
);

6
t/pt-table-checksum/error_handling.t
View File

@@ -178,8 +178,8 @@ is(
# Use the --replicate table created by the previous ^ tests.
# Create a user that can't create the --replicate table.
diag(`/tmp/12345/use -uroot < $trunk/t/lib/samples/ro-checksum-user.sql`);
diag(`/tmp/12345/use -uroot -e "GRANT REPLICATION CLIENT, REPLICATION SLAVE ON *.* TO ro_checksum_user\@'%'"`);
diag(`/tmp/12345/use -uroot -pmsandbox < $trunk/t/lib/samples/ro-checksum-user.sql 2>&1`);
diag(`/tmp/12345/use -uroot -pmsandbox -e "GRANT REPLICATION CLIENT, REPLICATION SLAVE ON *.* TO ro_checksum_user\@'%'" 2>&1`);
# Remove the --replicate table from slave1 and slave2,
# so it's only on the master...
@@ -199,7 +199,7 @@ like(
"CREATE DATABASE error and db is missing on slaves (bug 1039569)"
);
diag(`/tmp/12345/use -uroot -e "DROP USER ro_checksum_user\@'%'"`);
diag(`/tmp/12345/use -uroot -pmsandbox -e "DROP USER ro_checksum_user\@'%'" 2>&1`);
# #############################################################################
# Done.

2
t/pt-table-checksum/samples/default-results-5.1.txt
View File

@@ -20,7 +20,7 @@ ERRORS DIFFS ROWS SKIPPED TABLE
0 0 0 0 mysql.time_zone_transition
0 0 0 0 mysql.time_zone_transition_type
0 0 2 0 mysql.user
0 0 39 0 percona_test.checksums
0 0 37 0 percona_test.checksums
0 0 1 0 percona_test.load_data
0 0 1 0 percona_test.sentinel
0 0 200 0 sakila.actor

2
t/pt-table-checksum/samples/default-results-5.5.txt
View File

@@ -21,7 +21,7 @@ ERRORS DIFFS ROWS SKIPPED TABLE
0 0 0 0 mysql.time_zone_transition
0 0 0 0 mysql.time_zone_transition_type
0 0 2 0 mysql.user
0 0 40 0 percona_test.checksums
0 0 38 0 percona_test.checksums
0 0 1 0 percona_test.load_data
0 0 1 0 percona_test.sentinel
0 0 200 0 sakila.actor

10
t/pt-table-checksum/samples/default-results-5.6.txt
View File

@@ -1,12 +1,12 @@
ERRORS DIFFS ROWS SKIPPED TABLE
0 0 0 0 mysql.columns_priv
0 0 2 0 mysql.db
0 0 0 0 mysql.db
0 0 0 0 mysql.event
0 0 0 0 mysql.func
0 0 39 0 mysql.help_category
0 0 461 0 mysql.help_keyword
0 0 40 0 mysql.help_category
0 0 473 0 mysql.help_keyword
0 0 1045 0 mysql.help_relation
0 0 324 0 mysql.help_topic
0 0 529 0 mysql.help_topic
0 0 0 0 mysql.ndb_binlog_index
0 0 0 0 mysql.plugin
0 0 0 0 mysql.proc
@@ -20,7 +20,7 @@ ERRORS DIFFS ROWS SKIPPED TABLE
0 0 0 0 mysql.time_zone_transition
0 0 0 0 mysql.time_zone_transition_type
0 0 2 0 mysql.user
0 0 42 0 percona_test.checksums
0 0 37 0 percona_test.checksums
0 0 1 0 percona_test.load_data
0 0 1 0 percona_test.sentinel
0 0 200 0 sakila.actor

2
t/pt-table-checksum/samples/static-chunk-size-results-5.1.txt
View File

@@ -20,7 +20,7 @@ ERRORS DIFFS ROWS CHUNKS SKIPPED TABLE
0 0 0 1 0 mysql.time_zone_transition
0 0 0 1 0 mysql.time_zone_transition_type
0 0 2 1 0 mysql.user
0 0 39 1 0 percona_test.checksums
0 0 37 1 0 percona_test.checksums
0 0 1 1 0 percona_test.load_data
0 0 1 1 0 percona_test.sentinel
0 0 200 1 0 sakila.actor

2
t/pt-table-checksum/samples/static-chunk-size-results-5.5.txt
View File

@@ -21,7 +21,7 @@ ERRORS DIFFS ROWS CHUNKS SKIPPED TABLE
0 0 0 1 0 mysql.time_zone_transition
0 0 0 1 0 mysql.time_zone_transition_type
0 0 2 1 0 mysql.user
0 0 40 1 0 percona_test.checksums
0 0 38 1 0 percona_test.checksums
0 0 1 1 0 percona_test.load_data
0 0 1 1 0 percona_test.sentinel
0 0 200 1 0 sakila.actor

10
t/pt-table-checksum/samples/static-chunk-size-results-5.6.txt
View File

@@ -1,12 +1,12 @@
ERRORS DIFFS ROWS CHUNKS SKIPPED TABLE
0 0 0 1 0 mysql.columns_priv
0 0 2 1 0 mysql.db
0 0 0 1 0 mysql.db
0 0 0 1 0 mysql.event
0 0 0 1 0 mysql.func
0 0 39 1 0 mysql.help_category
0 0 461 1 0 mysql.help_keyword
0 0 40 1 0 mysql.help_category
0 0 473 1 0 mysql.help_keyword
0 0 1045 1 0 mysql.help_relation
0 0 324 1 0 mysql.help_topic
0 0 529 1 0 mysql.help_topic
0 0 0 1 0 mysql.ndb_binlog_index
0 0 0 1 0 mysql.plugin
0 0 0 1 0 mysql.proc
@@ -20,7 +20,7 @@ ERRORS DIFFS ROWS CHUNKS SKIPPED TABLE
0 0 0 1 0 mysql.time_zone_transition
0 0 0 1 0 mysql.time_zone_transition_type
0 0 2 1 0 mysql.user
0 0 42 1 0 percona_test.checksums
0 0 37 1 0 percona_test.checksums
0 0 1 1 0 percona_test.load_data
0 0 1 1 0 percona_test.sentinel
0 0 200 1 0 sakila.actor

32
t/pt-table-checksum/skip_innodb.t
View File

@@ -15,12 +15,15 @@ use PerconaTest;
use Sandbox;
require "$trunk/bin/pt-table-checksum";
if ( $sandbox_version eq '5.6' ) {
plan skip_all => 'http://bugs.mysql.com/67798';
if ( $sandbox_version ge '5.6' ) {
plan skip_all => 'Cannot disable InnoDB in MySQL 5.6';
}
diag(`$trunk/sandbox/stop-sandbox 12348 12349 >/dev/null`);
diag("Stopping/reconfiguring/restarting sandboxes 12348 and 12349");
diag(`$trunk/sandbox/stop-sandbox 12348 >/dev/null`);
diag(`SKIP_INNODB=1 $trunk/sandbox/start-sandbox master 12348 >/dev/null`);
diag(`$trunk/sandbox/stop-sandbox 12349 >/dev/null`);
diag(`SKIP_INNODB=1 $trunk/sandbox/start-sandbox slave 12349 12348 >/dev/null`);
my $dp = new DSNParser(opts=>$dsn_opts);
@@ -43,26 +46,6 @@ my @args = ($master_dsn, qw(--lock-wait-timeout 3), '--max-load', '');
my $output;
my $retval;
if ( $sandbox_version ge '5.6' ) {
# Before MySQL 5.6, even with the InnoDB engine off, creating an InnoDB
# table would simply result in:
#
# mysql> create table t (i int) engine=innodb;
# Query OK, 0 rows affected, 2 warnings (0.01 sec)
#
# mysql> show warnings;
# +---------+------+-------------------------------------------+
# | Level | Code | Message |
# +---------+------+-------------------------------------------+
# | Warning | 1286 | Unknown table engine 'innodb' |
# | Warning | 1266 | Using storage engine MyISAM for table 't' |
# +---------+------+-------------------------------------------+
#
# But 5.6 throws an error. So we have to create the table manually.
$sb->load_file('master1', "t/pt-table-checksum/samples/repl-table-myisam.sql");
$sb->wait_for_slaves(master => 'master1', slave => 'master2');
}
$output = output(
sub { $retval = pt_table_checksum::main(@args) },
stderr => 1,
@@ -78,12 +61,11 @@ is(
$retval,
0,
"0 exit status (bug 996110)"
) or diag($output);
);
# #############################################################################
# Done.
# #############################################################################
$sb->wipe_clean($master_dbh);
diag(`$trunk/sandbox/stop-sandbox 12349 12348 >/dev/null`);
ok($sb->ok(), "Sandbox servers") or BAIL_OUT(__FILE__ . " broke the sandbox");
done_testing;

3
t/pt-table-sync/traces.t
View File

@@ -63,10 +63,11 @@ output(
# dst_db:test dst_tbl:t2 dst_dsn:P=12346,h=127.0.0.1,p=...,u=msandbox
# lock:1 transaction:0 changing_src:1 replicate:0 bidirectional:0 pid:0
# user:$ENV{USER} host:-*/
my $user = $ENV{USER} ? "user:$ENV{USER}" : '';
my $output = `$mysqlbinlog /tmp/12345/data/$pos->{file} --start-position=$pos->{position} | grep 'percona-toolkit'`;
like(
$output,
qr/DELETE FROM.*test`.`t2.*percona-toolkit src_db:test.*user:$ENV{USER}/,
qr/DELETE FROM.*test`.`t2.*percona-toolkit src_db:test.*$user/,
"Trace message appended to change SQL"
);

3
util/checksum-test-dataset
View File

@@ -44,7 +44,8 @@ my $dbh = DBI->connect(
# Sandbox::ok() will throw "ERROR: Tables are different on master: mysql.proc"
$dbh->do("UPDATE mysql.proc SET created='2012-06-05 00:00:00', modified='2012-06-05 00:00:00'");
my @tables_in_mysql = grep { !/^innodb_(?:table|index)_stats$/ }
my @tables_in_mysql = grep { !/^(?:innodb|slave)_/ }
grep { !/_log$/ }
@{$dbh->selectcol_arrayref('SHOW TABLES FROM mysql')};
my @tables_in_sakila = qw( actor address category city country customer
film film_actor film_category film_text inventory