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

Updqte Quoter in all tools.

Browse Source
This commit is contained in:
Daniel Nichter
2013-02-18 12:31:18 -07:00
parent 58f4f06fbb
commit a07c0c0a6a
16 changed files with 855 additions and 554 deletions
Download Patch File Download Diff File Expand all files Collapse all files

82
bin/pt-archiver
View File

@@ -2521,6 +2521,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;
@@ -2585,51 +2590,64 @@ sub join_quote {
sub serialize_list {
my ( $self, @args ) = @_;
return unless @args;
PTDEBUG && _d('Serializing', Dumper(\@args));
die "Cannot serialize an empty array" unless scalar @args;
return $args[0] if @args == 1 && !defined $args[0];
return join ',', map {
my $c = $_;
if ( defined($c) ) {
$c =~ s/([^A-Za-z0-9])/\\$1/g;
$c
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 {
'\\N'
push @parts, '\N';
}
} @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 @unescaped_parts = map {
my $part = $_;
if ($part eq '\\N') {
undef
my @parts;
foreach my $arg ( split(/(?<!\\),/, $string) ) {
if ( $arg eq '\N' ) {
$arg = undef;
}
else {
$part =~ s/\\([^A-Za-z0-9])/$1/g;
$part;
$arg =~ s/\\,/,/g;
$arg =~ s/\\\\N/\\N/g;
}
push @parts, $arg;
}
} @escaped_parts;
return @unescaped_parts;
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, '';
}
PTDEBUG && _d('Deserialized', Dumper(\@parts));
return @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;

82
bin/pt-deadlock-logger
View File

@@ -1729,6 +1729,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;
@@ -1793,51 +1798,64 @@ sub join_quote {
sub serialize_list {
my ( $self, @args ) = @_;
return unless @args;
PTDEBUG && _d('Serializing', Dumper(\@args));
die "Cannot serialize an empty array" unless scalar @args;
return $args[0] if @args == 1 && !defined $args[0];
return join ',', map {
my $c = $_;
if ( defined($c) ) {
$c =~ s/([^A-Za-z0-9])/\\$1/g;
$c
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 {
'\\N'
push @parts, '\N';
}
} @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 @unescaped_parts = map {
my $part = $_;
if ($part eq '\\N') {
undef
my @parts;
foreach my $arg ( split(/(?<!\\),/, $string) ) {
if ( $arg eq '\N' ) {
$arg = undef;
}
else {
$part =~ s/\\([^A-Za-z0-9])/$1/g;
$part;
$arg =~ s/\\,/,/g;
$arg =~ s/\\\\N/\\N/g;
}
push @parts, $arg;
}
} @escaped_parts;
return @unescaped_parts;
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, '';
}
PTDEBUG && _d('Deserialized', Dumper(\@parts));
return @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;

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

@@ -63,6 +63,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;
@@ -127,51 +132,64 @@ sub join_quote {
sub serialize_list {
my ( $self, @args ) = @_;
return unless @args;
PTDEBUG && _d('Serializing', Dumper(\@args));
die "Cannot serialize an empty array" unless scalar @args;
return $args[0] if @args == 1 && !defined $args[0];
return join ',', map {
my $c = $_;
if ( defined($c) ) {
$c =~ s/([^A-Za-z0-9])/\\$1/g;
$c
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 {
'\\N'
push @parts, '\N';
}
} @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 @unescaped_parts = map {
my $part = $_;
if ($part eq '\\N') {
undef
my @parts;
foreach my $arg ( split(/(?<!\\),/, $string) ) {
if ( $arg eq '\N' ) {
$arg = undef;
}
else {
$part =~ s/\\([^A-Za-z0-9])/$1/g;
$part;
$arg =~ s/\\,/,/g;
$arg =~ s/\\\\N/\\N/g;
}
push @parts, $arg;
}
} @escaped_parts;
return @unescaped_parts;
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, '';
}
PTDEBUG && _d('Deserialized', Dumper(\@parts));
return @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;

82
bin/pt-find
View File

@@ -1461,6 +1461,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;
@@ -1525,51 +1530,64 @@ sub join_quote {
sub serialize_list {
my ( $self, @args ) = @_;
return unless @args;
PTDEBUG && _d('Serializing', Dumper(\@args));
die "Cannot serialize an empty array" unless scalar @args;
return $args[0] if @args == 1 && !defined $args[0];
return join ',', map {
my $c = $_;
if ( defined($c) ) {
$c =~ s/([^A-Za-z0-9])/\\$1/g;
$c
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 {
'\\N'
push @parts, '\N';
}
} @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 @unescaped_parts = map {
my $part = $_;
if ($part eq '\\N') {
undef
my @parts;
foreach my $arg ( split(/(?<!\\),/, $string) ) {
if ( $arg eq '\N' ) {
$arg = undef;
}
else {
$part =~ s/\\([^A-Za-z0-9])/$1/g;
$part;
$arg =~ s/\\,/,/g;
$arg =~ s/\\\\N/\\N/g;
}
push @parts, $arg;
}
} @escaped_parts;
return @unescaped_parts;
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, '';
}
PTDEBUG && _d('Deserialized', Dumper(\@parts));
return @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;

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

@@ -1084,6 +1084,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;
@@ -1148,51 +1153,64 @@ sub join_quote {
sub serialize_list {
my ( $self, @args ) = @_;
return unless @args;
PTDEBUG && _d('Serializing', Dumper(\@args));
die "Cannot serialize an empty array" unless scalar @args;
return $args[0] if @args == 1 && !defined $args[0];
return join ',', map {
my $c = $_;
if ( defined($c) ) {
$c =~ s/([^A-Za-z0-9])/\\$1/g;
$c
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 {
'\\N'
push @parts, '\N';
}
} @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 @unescaped_parts = map {
my $part = $_;
if ($part eq '\\N') {
undef
my @parts;
foreach my $arg ( split(/(?<!\\),/, $string) ) {
if ( $arg eq '\N' ) {
$arg = undef;
}
else {
$part =~ s/\\([^A-Za-z0-9])/$1/g;
$part;
$arg =~ s/\\,/,/g;
$arg =~ s/\\\\N/\\N/g;
}
push @parts, $arg;
}
} @escaped_parts;
return @unescaped_parts;
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, '';
}
PTDEBUG && _d('Deserialized', Dumper(\@parts));
return @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;

82
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,51 +2468,64 @@ sub join_quote {
sub serialize_list {
my ( $self, @args ) = @_;
return unless @args;
PTDEBUG && _d('Serializing', Dumper(\@args));
die "Cannot serialize an empty array" unless scalar @args;
return $args[0] if @args == 1 && !defined $args[0];
return join ',', map {
my $c = $_;
if ( defined($c) ) {
$c =~ s/([^A-Za-z0-9])/\\$1/g;
$c
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 {
'\\N'
push @parts, '\N';
}
} @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 @unescaped_parts = map {
my $part = $_;
if ($part eq '\\N') {
undef
my @parts;
foreach my $arg ( split(/(?<!\\),/, $string) ) {
if ( $arg eq '\N' ) {
$arg = undef;
}
else {
$part =~ s/\\([^A-Za-z0-9])/$1/g;
$part;
$arg =~ s/\\,/,/g;
$arg =~ s/\\\\N/\\N/g;
}
push @parts, $arg;
}
} @escaped_parts;
return @unescaped_parts;
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, '';
}
PTDEBUG && _d('Deserialized', Dumper(\@parts));
return @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;

82
bin/pt-index-usage
View File

@@ -446,6 +446,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;
@@ -510,51 +515,64 @@ sub join_quote {
sub serialize_list {
my ( $self, @args ) = @_;
return unless @args;
PTDEBUG && _d('Serializing', Dumper(\@args));
die "Cannot serialize an empty array" unless scalar @args;
return $args[0] if @args == 1 && !defined $args[0];
return join ',', map {
my $c = $_;
if ( defined($c) ) {
$c =~ s/([^A-Za-z0-9])/\\$1/g;
$c
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 {
'\\N'
push @parts, '\N';
}
} @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 @unescaped_parts = map {
my $part = $_;
if ($part eq '\\N') {
undef
my @parts;
foreach my $arg ( split(/(?<!\\),/, $string) ) {
if ( $arg eq '\N' ) {
$arg = undef;
}
else {
$part =~ s/\\([^A-Za-z0-9])/$1/g;
$part;
$arg =~ s/\\,/,/g;
$arg =~ s/\\\\N/\\N/g;
}
push @parts, $arg;
}
} @escaped_parts;
return @unescaped_parts;
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, '';
}
PTDEBUG && _d('Deserialized', Dumper(\@parts));
return @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;

82
bin/pt-kill
View File

@@ -4122,6 +4122,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;
@@ -4186,51 +4191,64 @@ sub join_quote {
sub serialize_list {
my ( $self, @args ) = @_;
return unless @args;
PTDEBUG && _d('Serializing', Dumper(\@args));
die "Cannot serialize an empty array" unless scalar @args;
return $args[0] if @args == 1 && !defined $args[0];
return join ',', map {
my $c = $_;
if ( defined($c) ) {
$c =~ s/([^A-Za-z0-9])/\\$1/g;
$c
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 {
'\\N'
push @parts, '\N';
}
} @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 @unescaped_parts = map {
my $part = $_;
if ($part eq '\\N') {
undef
my @parts;
foreach my $arg ( split(/(?<!\\),/, $string) ) {
if ( $arg eq '\N' ) {
$arg = undef;
}
else {
$part =~ s/\\([^A-Za-z0-9])/$1/g;
$part;
$arg =~ s/\\,/,/g;
$arg =~ s/\\\\N/\\N/g;
}
push @parts, $arg;
}
} @escaped_parts;
return @unescaped_parts;
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, '';
}
PTDEBUG && _d('Deserialized', Dumper(\@parts));
return @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;

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

@@ -2677,6 +2677,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;
@@ -2741,51 +2746,64 @@ sub join_quote {
sub serialize_list {
my ( $self, @args ) = @_;
return unless @args;
PTDEBUG && _d('Serializing', Dumper(\@args));
die "Cannot serialize an empty array" unless scalar @args;
return $args[0] if @args == 1 && !defined $args[0];
return join ',', map {
my $c = $_;
if ( defined($c) ) {
$c =~ s/([^A-Za-z0-9])/\\$1/g;
$c
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 {
'\\N'
push @parts, '\N';
}
} @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 @unescaped_parts = map {
my $part = $_;
if ($part eq '\\N') {
undef
my @parts;
foreach my $arg ( split(/(?<!\\),/, $string) ) {
if ( $arg eq '\N' ) {
$arg = undef;
}
else {
$part =~ s/\\([^A-Za-z0-9])/$1/g;
$part;
$arg =~ s/\\,/,/g;
$arg =~ s/\\\\N/\\N/g;
}
push @parts, $arg;
}
} @escaped_parts;
return @unescaped_parts;
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, '';
}
PTDEBUG && _d('Deserialized', Dumper(\@parts));
return @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;

82
bin/pt-query-advisor
View File

@@ -1472,6 +1472,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;
@@ -1536,51 +1541,64 @@ sub join_quote {
sub serialize_list {
my ( $self, @args ) = @_;
return unless @args;
PTDEBUG && _d('Serializing', Dumper(\@args));
die "Cannot serialize an empty array" unless scalar @args;
return $args[0] if @args == 1 && !defined $args[0];
return join ',', map {
my $c = $_;
if ( defined($c) ) {
$c =~ s/([^A-Za-z0-9])/\\$1/g;
$c
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 {
'\\N'
push @parts, '\N';
}
} @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 @unescaped_parts = map {
my $part = $_;
if ($part eq '\\N') {
undef
my @parts;
foreach my $arg ( split(/(?<!\\),/, $string) ) {
if ( $arg eq '\N' ) {
$arg = undef;
}
else {
$part =~ s/\\([^A-Za-z0-9])/$1/g;
$part;
$arg =~ s/\\,/,/g;
$arg =~ s/\\\\N/\\N/g;
}
push @parts, $arg;
}
} @escaped_parts;
return @unescaped_parts;
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, '';
}
PTDEBUG && _d('Deserialized', Dumper(\@parts));
return @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;

82
bin/pt-query-digest
View File

@@ -465,6 +465,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;
@@ -529,51 +534,64 @@ sub join_quote {
sub serialize_list {
my ( $self, @args ) = @_;
return unless @args;
PTDEBUG && _d('Serializing', Dumper(\@args));
die "Cannot serialize an empty array" unless scalar @args;
return $args[0] if @args == 1 && !defined $args[0];
return join ',', map {
my $c = $_;
if ( defined($c) ) {
$c =~ s/([^A-Za-z0-9])/\\$1/g;
$c
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 {
'\\N'
push @parts, '\N';
}
} @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 @unescaped_parts = map {
my $part = $_;
if ($part eq '\\N') {
undef
my @parts;
foreach my $arg ( split(/(?<!\\),/, $string) ) {
if ( $arg eq '\N' ) {
$arg = undef;
}
else {
$part =~ s/\\([^A-Za-z0-9])/$1/g;
$part;
$arg =~ s/\\,/,/g;
$arg =~ s/\\\\N/\\N/g;
}
push @parts, $arg;
}
} @escaped_parts;
return @unescaped_parts;
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, '';
}
PTDEBUG && _d('Deserialized', Dumper(\@parts));
return @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;

82
bin/pt-slave-restart
View File

@@ -61,6 +61,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;
@@ -125,51 +130,64 @@ sub join_quote {
sub serialize_list {
my ( $self, @args ) = @_;
return unless @args;
PTDEBUG && _d('Serializing', Dumper(\@args));
die "Cannot serialize an empty array" unless scalar @args;
return $args[0] if @args == 1 && !defined $args[0];
return join ',', map {
my $c = $_;
if ( defined($c) ) {
$c =~ s/([^A-Za-z0-9])/\\$1/g;
$c
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 {
'\\N'
push @parts, '\N';
}
} @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 @unescaped_parts = map {
my $part = $_;
if ($part eq '\\N') {
undef
my @parts;
foreach my $arg ( split(/(?<!\\),/, $string) ) {
if ( $arg eq '\N' ) {
$arg = undef;
}
else {
$part =~ s/\\([^A-Za-z0-9])/$1/g;
$part;
$arg =~ s/\\,/,/g;
$arg =~ s/\\\\N/\\N/g;
}
push @parts, $arg;
}
} @escaped_parts;
return @unescaped_parts;
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, '';
}
PTDEBUG && _d('Deserialized', Dumper(\@parts));
return @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;

82
bin/pt-table-checksum
View File

@@ -3459,6 +3459,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;
@@ -3523,51 +3528,64 @@ sub join_quote {
sub serialize_list {
my ( $self, @args ) = @_;
return unless @args;
PTDEBUG && _d('Serializing', Dumper(\@args));
die "Cannot serialize an empty array" unless scalar @args;
return $args[0] if @args == 1 && !defined $args[0];
return join ',', map {
my $c = $_;
if ( defined($c) ) {
$c =~ s/([^A-Za-z0-9])/\\$1/g;
$c
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 {
'\\N'
push @parts, '\N';
}
} @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 @unescaped_parts = map {
my $part = $_;
if ($part eq '\\N') {
undef
my @parts;
foreach my $arg ( split(/(?<!\\),/, $string) ) {
if ( $arg eq '\N' ) {
$arg = undef;
}
else {
$part =~ s/\\([^A-Za-z0-9])/$1/g;
$part;
$arg =~ s/\\,/,/g;
$arg =~ s/\\\\N/\\N/g;
}
push @parts, $arg;
}
} @escaped_parts;
return @unescaped_parts;
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, '';
}
PTDEBUG && _d('Deserialized', Dumper(\@parts));
return @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;

82
bin/pt-table-sync
View File

@@ -1552,6 +1552,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;
@@ -1616,51 +1621,64 @@ sub join_quote {
sub serialize_list {
my ( $self, @args ) = @_;
return unless @args;
PTDEBUG && _d('Serializing', Dumper(\@args));
die "Cannot serialize an empty array" unless scalar @args;
return $args[0] if @args == 1 && !defined $args[0];
return join ',', map {
my $c = $_;
if ( defined($c) ) {
$c =~ s/([^A-Za-z0-9])/\\$1/g;
$c
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 {
'\\N'
push @parts, '\N';
}
} @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 @unescaped_parts = map {
my $part = $_;
if ($part eq '\\N') {
undef
my @parts;
foreach my $arg ( split(/(?<!\\),/, $string) ) {
if ( $arg eq '\N' ) {
$arg = undef;
}
else {
$part =~ s/\\([^A-Za-z0-9])/$1/g;
$part;
$arg =~ s/\\,/,/g;
$arg =~ s/\\\\N/\\N/g;
}
push @parts, $arg;
}
} @escaped_parts;
return @unescaped_parts;
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, '';
}
PTDEBUG && _d('Deserialized', Dumper(\@parts));
return @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;

89
bin/pt-table-usage
View File

@@ -5512,6 +5512,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;
@@ -5539,12 +5544,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);
}
@@ -5570,44 +5581,64 @@ sub join_quote {
sub serialize_list {
my ( $self, @args ) = @_;
return unless @args;
PTDEBUG && _d('Serializing', Dumper(\@args));
die "Cannot serialize an empty array" unless scalar @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;

82
bin/pt-upgrade
View File

@@ -870,6 +870,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;
@@ -934,51 +939,64 @@ sub join_quote {
sub serialize_list {
my ( $self, @args ) = @_;
return unless @args;
PTDEBUG && _d('Serializing', Dumper(\@args));
die "Cannot serialize an empty array" unless scalar @args;
return $args[0] if @args == 1 && !defined $args[0];
return join ',', map {
my $c = $_;
if ( defined($c) ) {
$c =~ s/([^A-Za-z0-9])/\\$1/g;
$c
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 {
'\\N'
push @parts, '\N';
}
} @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 @unescaped_parts = map {
my $part = $_;
if ($part eq '\\N') {
undef
my @parts;
foreach my $arg ( split(/(?<!\\),/, $string) ) {
if ( $arg eq '\N' ) {
$arg = undef;
}
else {
$part =~ s/\\([^A-Za-z0-9])/$1/g;
$part;
$arg =~ s/\\,/,/g;
$arg =~ s/\\\\N/\\N/g;
}
push @parts, $arg;
}
} @escaped_parts;
return @unescaped_parts;
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, '';
}
PTDEBUG && _d('Deserialized', Dumper(\@parts));
return @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;