mirror of
https://github.com/percona/percona-toolkit.git
synced 2025-09-10 13:11:32 +00:00
Update all modules that use Quoter
This commit is contained in:
@@ -2589,10 +2589,16 @@ sub serialize_list {
|
||||
|
||||
return $args[0] if @args == 1 && !defined $args[0];
|
||||
|
||||
die "Cannot serialize multiple values with undef/NULL"
|
||||
if grep { !defined $_ } @args;
|
||||
|
||||
return join ',', map { quotemeta } @args;
|
||||
return join ',', map {
|
||||
my $c = $_;
|
||||
if ( defined($c) ) {
|
||||
$c =~ s/([^A-Za-z0-9])/\\$1/g;
|
||||
$c
|
||||
}
|
||||
else {
|
||||
'\\N'
|
||||
}
|
||||
} @args;
|
||||
}
|
||||
|
||||
sub deserialize_list {
|
||||
@@ -2614,14 +2620,15 @@ sub deserialize_list {
|
||||
|
||||
my @unescaped_parts = map {
|
||||
my $part = $_;
|
||||
|
||||
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;
|
||||
if ($part eq '\\N') {
|
||||
undef
|
||||
}
|
||||
else {
|
||||
$part =~ s/\\([^A-Za-z0-9])/$1/g;
|
||||
$part;
|
||||
}
|
||||
} @escaped_parts;
|
||||
|
||||
|
||||
return @unescaped_parts;
|
||||
}
|
||||
|
||||
|
@@ -1797,10 +1797,16 @@ sub serialize_list {
|
||||
|
||||
return $args[0] if @args == 1 && !defined $args[0];
|
||||
|
||||
die "Cannot serialize multiple values with undef/NULL"
|
||||
if grep { !defined $_ } @args;
|
||||
|
||||
return join ',', map { quotemeta } @args;
|
||||
return join ',', map {
|
||||
my $c = $_;
|
||||
if ( defined($c) ) {
|
||||
$c =~ s/([^A-Za-z0-9])/\\$1/g;
|
||||
$c
|
||||
}
|
||||
else {
|
||||
'\\N'
|
||||
}
|
||||
} @args;
|
||||
}
|
||||
|
||||
sub deserialize_list {
|
||||
@@ -1822,14 +1828,15 @@ sub deserialize_list {
|
||||
|
||||
my @unescaped_parts = map {
|
||||
my $part = $_;
|
||||
|
||||
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;
|
||||
if ($part eq '\\N') {
|
||||
undef
|
||||
}
|
||||
else {
|
||||
$part =~ s/\\([^A-Za-z0-9])/$1/g;
|
||||
$part;
|
||||
}
|
||||
} @escaped_parts;
|
||||
|
||||
|
||||
return @unescaped_parts;
|
||||
}
|
||||
|
||||
|
@@ -131,10 +131,16 @@ sub serialize_list {
|
||||
|
||||
return $args[0] if @args == 1 && !defined $args[0];
|
||||
|
||||
die "Cannot serialize multiple values with undef/NULL"
|
||||
if grep { !defined $_ } @args;
|
||||
|
||||
return join ',', map { quotemeta } @args;
|
||||
return join ',', map {
|
||||
my $c = $_;
|
||||
if ( defined($c) ) {
|
||||
$c =~ s/([^A-Za-z0-9])/\\$1/g;
|
||||
$c
|
||||
}
|
||||
else {
|
||||
'\\N'
|
||||
}
|
||||
} @args;
|
||||
}
|
||||
|
||||
sub deserialize_list {
|
||||
@@ -156,14 +162,15 @@ sub deserialize_list {
|
||||
|
||||
my @unescaped_parts = map {
|
||||
my $part = $_;
|
||||
|
||||
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;
|
||||
if ($part eq '\\N') {
|
||||
undef
|
||||
}
|
||||
else {
|
||||
$part =~ s/\\([^A-Za-z0-9])/$1/g;
|
||||
$part;
|
||||
}
|
||||
} @escaped_parts;
|
||||
|
||||
|
||||
return @unescaped_parts;
|
||||
}
|
||||
|
||||
@@ -3026,11 +3033,16 @@ sub next {
|
||||
|
||||
if ( !$self->{initialized} ) {
|
||||
$self->{initialized} = 1;
|
||||
if ( $self->{resume}->{tbl}
|
||||
&& !$self->table_is_allowed(@{$self->{resume}}{qw(db tbl)}) ) {
|
||||
PTDEBUG && _d('Will resume after',
|
||||
join('.', @{$self->{resume}}{qw(db tbl)}));
|
||||
$self->{resume}->{after} = 1;
|
||||
if ( $self->{resume}->{tbl} ) {
|
||||
if ( !$self->table_is_allowed(@{$self->{resume}}{qw(db tbl)}) ) {
|
||||
PTDEBUG && _d('Will resume after',
|
||||
join('.', @{$self->{resume}}{qw(db tbl)}));
|
||||
$self->{resume}->{after}->{tbl} = 1;
|
||||
}
|
||||
if ( !$self->database_is_allowed($self->{resume}->{db}) ) {
|
||||
PTDEBUG && _d('Will resume after', $self->{resume}->{db});
|
||||
$self->{resume}->{after}->{db} = 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@@ -3128,16 +3140,17 @@ sub _iterate_dbh {
|
||||
if ( !defined $self->{dbs} ) {
|
||||
my $sql = 'SHOW DATABASES';
|
||||
PTDEBUG && _d($sql);
|
||||
my @dbs = grep { $self->database_is_allowed($_) }
|
||||
@{$dbh->selectcol_arrayref($sql)};
|
||||
my @dbs = grep {
|
||||
$self->_resume_from_database($_)
|
||||
&&
|
||||
$self->database_is_allowed($_)
|
||||
} @{$dbh->selectcol_arrayref($sql)};
|
||||
PTDEBUG && _d('Found', scalar @dbs, 'databases');
|
||||
$self->{dbs} = \@dbs;
|
||||
}
|
||||
|
||||
if ( !$self->{db} ) {
|
||||
do {
|
||||
$self->{db} = shift @{$self->{dbs}};
|
||||
} until $self->_resume_from_database($self->{db});
|
||||
$self->{db} = shift @{$self->{dbs}};
|
||||
PTDEBUG && _d('Next database:', $self->{db});
|
||||
return unless $self->{db};
|
||||
}
|
||||
@@ -3310,11 +3323,17 @@ sub _resume_from_database {
|
||||
my ($self, $db) = @_;
|
||||
|
||||
return 1 unless $self->{resume}->{db};
|
||||
|
||||
if ( $db eq $self->{resume}->{db} ) {
|
||||
PTDEBUG && _d('At resume db', $db);
|
||||
delete $self->{resume}->{db};
|
||||
return 1;
|
||||
if ( !$self->{resume}->{after}->{db} ) {
|
||||
PTDEBUG && _d('Resuming from db', $db);
|
||||
delete $self->{resume}->{db};
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
PTDEBUG && _d('Resuming after db', $db);
|
||||
delete $self->{resume}->{db};
|
||||
delete $self->{resume}->{tbl};
|
||||
}
|
||||
}
|
||||
|
||||
return 0;
|
||||
@@ -3326,7 +3345,7 @@ sub _resume_from_table {
|
||||
return 1 unless $self->{resume}->{tbl};
|
||||
|
||||
if ( $tbl eq $self->{resume}->{tbl} ) {
|
||||
if ( !$self->{resume}->{after} ) {
|
||||
if ( !$self->{resume}->{after}->{tbl} ) {
|
||||
PTDEBUG && _d('Resuming from table', $tbl);
|
||||
delete $self->{resume}->{tbl};
|
||||
return 1;
|
||||
|
29
bin/pt-find
29
bin/pt-find
@@ -1529,10 +1529,16 @@ sub serialize_list {
|
||||
|
||||
return $args[0] if @args == 1 && !defined $args[0];
|
||||
|
||||
die "Cannot serialize multiple values with undef/NULL"
|
||||
if grep { !defined $_ } @args;
|
||||
|
||||
return join ',', map { quotemeta } @args;
|
||||
return join ',', map {
|
||||
my $c = $_;
|
||||
if ( defined($c) ) {
|
||||
$c =~ s/([^A-Za-z0-9])/\\$1/g;
|
||||
$c
|
||||
}
|
||||
else {
|
||||
'\\N'
|
||||
}
|
||||
} @args;
|
||||
}
|
||||
|
||||
sub deserialize_list {
|
||||
@@ -1554,14 +1560,15 @@ sub deserialize_list {
|
||||
|
||||
my @unescaped_parts = map {
|
||||
my $part = $_;
|
||||
|
||||
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;
|
||||
if ($part eq '\\N') {
|
||||
undef
|
||||
}
|
||||
else {
|
||||
$part =~ s/\\([^A-Za-z0-9])/$1/g;
|
||||
$part;
|
||||
}
|
||||
} @escaped_parts;
|
||||
|
||||
|
||||
return @unescaped_parts;
|
||||
}
|
||||
|
||||
|
@@ -1152,10 +1152,16 @@ sub serialize_list {
|
||||
|
||||
return $args[0] if @args == 1 && !defined $args[0];
|
||||
|
||||
die "Cannot serialize multiple values with undef/NULL"
|
||||
if grep { !defined $_ } @args;
|
||||
|
||||
return join ',', map { quotemeta } @args;
|
||||
return join ',', map {
|
||||
my $c = $_;
|
||||
if ( defined($c) ) {
|
||||
$c =~ s/([^A-Za-z0-9])/\\$1/g;
|
||||
$c
|
||||
}
|
||||
else {
|
||||
'\\N'
|
||||
}
|
||||
} @args;
|
||||
}
|
||||
|
||||
sub deserialize_list {
|
||||
@@ -1177,14 +1183,15 @@ sub deserialize_list {
|
||||
|
||||
my @unescaped_parts = map {
|
||||
my $part = $_;
|
||||
|
||||
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;
|
||||
if ($part eq '\\N') {
|
||||
undef
|
||||
}
|
||||
else {
|
||||
$part =~ s/\\([^A-Za-z0-9])/$1/g;
|
||||
$part;
|
||||
}
|
||||
} @escaped_parts;
|
||||
|
||||
|
||||
return @unescaped_parts;
|
||||
}
|
||||
|
||||
|
@@ -2467,10 +2467,16 @@ sub serialize_list {
|
||||
|
||||
return $args[0] if @args == 1 && !defined $args[0];
|
||||
|
||||
die "Cannot serialize multiple values with undef/NULL"
|
||||
if grep { !defined $_ } @args;
|
||||
|
||||
return join ',', map { quotemeta } @args;
|
||||
return join ',', map {
|
||||
my $c = $_;
|
||||
if ( defined($c) ) {
|
||||
$c =~ s/([^A-Za-z0-9])/\\$1/g;
|
||||
$c
|
||||
}
|
||||
else {
|
||||
'\\N'
|
||||
}
|
||||
} @args;
|
||||
}
|
||||
|
||||
sub deserialize_list {
|
||||
@@ -2492,14 +2498,15 @@ sub deserialize_list {
|
||||
|
||||
my @unescaped_parts = map {
|
||||
my $part = $_;
|
||||
|
||||
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;
|
||||
if ($part eq '\\N') {
|
||||
undef
|
||||
}
|
||||
else {
|
||||
$part =~ s/\\([^A-Za-z0-9])/$1/g;
|
||||
$part;
|
||||
}
|
||||
} @escaped_parts;
|
||||
|
||||
|
||||
return @unescaped_parts;
|
||||
}
|
||||
|
||||
|
@@ -514,10 +514,16 @@ sub serialize_list {
|
||||
|
||||
return $args[0] if @args == 1 && !defined $args[0];
|
||||
|
||||
die "Cannot serialize multiple values with undef/NULL"
|
||||
if grep { !defined $_ } @args;
|
||||
|
||||
return join ',', map { quotemeta } @args;
|
||||
return join ',', map {
|
||||
my $c = $_;
|
||||
if ( defined($c) ) {
|
||||
$c =~ s/([^A-Za-z0-9])/\\$1/g;
|
||||
$c
|
||||
}
|
||||
else {
|
||||
'\\N'
|
||||
}
|
||||
} @args;
|
||||
}
|
||||
|
||||
sub deserialize_list {
|
||||
@@ -539,14 +545,15 @@ sub deserialize_list {
|
||||
|
||||
my @unescaped_parts = map {
|
||||
my $part = $_;
|
||||
|
||||
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;
|
||||
if ($part eq '\\N') {
|
||||
undef
|
||||
}
|
||||
else {
|
||||
$part =~ s/\\([^A-Za-z0-9])/$1/g;
|
||||
$part;
|
||||
}
|
||||
} @escaped_parts;
|
||||
|
||||
|
||||
return @unescaped_parts;
|
||||
}
|
||||
|
||||
@@ -2713,14 +2720,25 @@ sub parse_event {
|
||||
|
||||
if ( !$found_arg && $pos == $len ) {
|
||||
PTDEBUG && _d("Did not find arg, looking for special cases");
|
||||
local $INPUT_RECORD_SEPARATOR = ";\n";
|
||||
local $INPUT_RECORD_SEPARATOR = ";\n"; # get next line
|
||||
if ( defined(my $l = $next_event->()) ) {
|
||||
chomp $l;
|
||||
$l =~ s/^\s+//;
|
||||
PTDEBUG && _d("Found admin statement", $l);
|
||||
push @properties, 'cmd', 'Admin', 'arg', $l;
|
||||
push @properties, 'bytes', length($properties[-1]);
|
||||
$found_arg++;
|
||||
if ( $l =~ /^\s*[A-Z][a-z_]+: / ) {
|
||||
PTDEBUG && _d("Found NULL query before", $l);
|
||||
local $INPUT_RECORD_SEPARATOR = ";\n#";
|
||||
my $rest_of_event = $next_event->();
|
||||
push @{$self->{pending}}, $l . $rest_of_event;
|
||||
push @properties, 'cmd', 'Query', 'arg', '/* No query */';
|
||||
push @properties, 'bytes', 0;
|
||||
$found_arg++;
|
||||
}
|
||||
else {
|
||||
chomp $l;
|
||||
$l =~ s/^\s+//;
|
||||
PTDEBUG && _d("Found admin statement", $l);
|
||||
push @properties, 'cmd', 'Admin', 'arg', $l;
|
||||
push @properties, 'bytes', length($properties[-1]);
|
||||
$found_arg++;
|
||||
}
|
||||
}
|
||||
else {
|
||||
PTDEBUG && _d("I can't figure out what to do with this line");
|
||||
@@ -3844,11 +3862,16 @@ sub next {
|
||||
|
||||
if ( !$self->{initialized} ) {
|
||||
$self->{initialized} = 1;
|
||||
if ( $self->{resume}->{tbl}
|
||||
&& !$self->table_is_allowed(@{$self->{resume}}{qw(db tbl)}) ) {
|
||||
PTDEBUG && _d('Will resume after',
|
||||
join('.', @{$self->{resume}}{qw(db tbl)}));
|
||||
$self->{resume}->{after} = 1;
|
||||
if ( $self->{resume}->{tbl} ) {
|
||||
if ( !$self->table_is_allowed(@{$self->{resume}}{qw(db tbl)}) ) {
|
||||
PTDEBUG && _d('Will resume after',
|
||||
join('.', @{$self->{resume}}{qw(db tbl)}));
|
||||
$self->{resume}->{after}->{tbl} = 1;
|
||||
}
|
||||
if ( !$self->database_is_allowed($self->{resume}->{db}) ) {
|
||||
PTDEBUG && _d('Will resume after', $self->{resume}->{db});
|
||||
$self->{resume}->{after}->{db} = 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@@ -3946,16 +3969,17 @@ sub _iterate_dbh {
|
||||
if ( !defined $self->{dbs} ) {
|
||||
my $sql = 'SHOW DATABASES';
|
||||
PTDEBUG && _d($sql);
|
||||
my @dbs = grep { $self->database_is_allowed($_) }
|
||||
@{$dbh->selectcol_arrayref($sql)};
|
||||
my @dbs = grep {
|
||||
$self->_resume_from_database($_)
|
||||
&&
|
||||
$self->database_is_allowed($_)
|
||||
} @{$dbh->selectcol_arrayref($sql)};
|
||||
PTDEBUG && _d('Found', scalar @dbs, 'databases');
|
||||
$self->{dbs} = \@dbs;
|
||||
}
|
||||
|
||||
if ( !$self->{db} ) {
|
||||
do {
|
||||
$self->{db} = shift @{$self->{dbs}};
|
||||
} until $self->_resume_from_database($self->{db});
|
||||
$self->{db} = shift @{$self->{dbs}};
|
||||
PTDEBUG && _d('Next database:', $self->{db});
|
||||
return unless $self->{db};
|
||||
}
|
||||
@@ -4128,11 +4152,17 @@ sub _resume_from_database {
|
||||
my ($self, $db) = @_;
|
||||
|
||||
return 1 unless $self->{resume}->{db};
|
||||
|
||||
if ( $db eq $self->{resume}->{db} ) {
|
||||
PTDEBUG && _d('At resume db', $db);
|
||||
delete $self->{resume}->{db};
|
||||
return 1;
|
||||
if ( !$self->{resume}->{after}->{db} ) {
|
||||
PTDEBUG && _d('Resuming from db', $db);
|
||||
delete $self->{resume}->{db};
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
PTDEBUG && _d('Resuming after db', $db);
|
||||
delete $self->{resume}->{db};
|
||||
delete $self->{resume}->{tbl};
|
||||
}
|
||||
}
|
||||
|
||||
return 0;
|
||||
@@ -4144,7 +4174,7 @@ sub _resume_from_table {
|
||||
return 1 unless $self->{resume}->{tbl};
|
||||
|
||||
if ( $tbl eq $self->{resume}->{tbl} ) {
|
||||
if ( !$self->{resume}->{after} ) {
|
||||
if ( !$self->{resume}->{after}->{tbl} ) {
|
||||
PTDEBUG && _d('Resuming from table', $tbl);
|
||||
delete $self->{resume}->{tbl};
|
||||
return 1;
|
||||
|
29
bin/pt-kill
29
bin/pt-kill
@@ -4190,10 +4190,16 @@ sub serialize_list {
|
||||
|
||||
return $args[0] if @args == 1 && !defined $args[0];
|
||||
|
||||
die "Cannot serialize multiple values with undef/NULL"
|
||||
if grep { !defined $_ } @args;
|
||||
|
||||
return join ',', map { quotemeta } @args;
|
||||
return join ',', map {
|
||||
my $c = $_;
|
||||
if ( defined($c) ) {
|
||||
$c =~ s/([^A-Za-z0-9])/\\$1/g;
|
||||
$c
|
||||
}
|
||||
else {
|
||||
'\\N'
|
||||
}
|
||||
} @args;
|
||||
}
|
||||
|
||||
sub deserialize_list {
|
||||
@@ -4215,14 +4221,15 @@ sub deserialize_list {
|
||||
|
||||
my @unescaped_parts = map {
|
||||
my $part = $_;
|
||||
|
||||
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;
|
||||
if ($part eq '\\N') {
|
||||
undef
|
||||
}
|
||||
else {
|
||||
$part =~ s/\\([^A-Za-z0-9])/$1/g;
|
||||
$part;
|
||||
}
|
||||
} @escaped_parts;
|
||||
|
||||
|
||||
return @unescaped_parts;
|
||||
}
|
||||
|
||||
|
@@ -2745,10 +2745,16 @@ sub serialize_list {
|
||||
|
||||
return $args[0] if @args == 1 && !defined $args[0];
|
||||
|
||||
die "Cannot serialize multiple values with undef/NULL"
|
||||
if grep { !defined $_ } @args;
|
||||
|
||||
return join ',', map { quotemeta } @args;
|
||||
return join ',', map {
|
||||
my $c = $_;
|
||||
if ( defined($c) ) {
|
||||
$c =~ s/([^A-Za-z0-9])/\\$1/g;
|
||||
$c
|
||||
}
|
||||
else {
|
||||
'\\N'
|
||||
}
|
||||
} @args;
|
||||
}
|
||||
|
||||
sub deserialize_list {
|
||||
@@ -2770,14 +2776,15 @@ sub deserialize_list {
|
||||
|
||||
my @unescaped_parts = map {
|
||||
my $part = $_;
|
||||
|
||||
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;
|
||||
if ($part eq '\\N') {
|
||||
undef
|
||||
}
|
||||
else {
|
||||
$part =~ s/\\([^A-Za-z0-9])/$1/g;
|
||||
$part;
|
||||
}
|
||||
} @escaped_parts;
|
||||
|
||||
|
||||
return @unescaped_parts;
|
||||
}
|
||||
|
||||
|
@@ -1540,10 +1540,16 @@ sub serialize_list {
|
||||
|
||||
return $args[0] if @args == 1 && !defined $args[0];
|
||||
|
||||
die "Cannot serialize multiple values with undef/NULL"
|
||||
if grep { !defined $_ } @args;
|
||||
|
||||
return join ',', map { quotemeta } @args;
|
||||
return join ',', map {
|
||||
my $c = $_;
|
||||
if ( defined($c) ) {
|
||||
$c =~ s/([^A-Za-z0-9])/\\$1/g;
|
||||
$c
|
||||
}
|
||||
else {
|
||||
'\\N'
|
||||
}
|
||||
} @args;
|
||||
}
|
||||
|
||||
sub deserialize_list {
|
||||
@@ -1565,14 +1571,15 @@ sub deserialize_list {
|
||||
|
||||
my @unescaped_parts = map {
|
||||
my $part = $_;
|
||||
|
||||
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;
|
||||
if ($part eq '\\N') {
|
||||
undef
|
||||
}
|
||||
else {
|
||||
$part =~ s/\\([^A-Za-z0-9])/$1/g;
|
||||
$part;
|
||||
}
|
||||
} @escaped_parts;
|
||||
|
||||
|
||||
return @unescaped_parts;
|
||||
}
|
||||
|
||||
@@ -1727,14 +1734,25 @@ sub parse_event {
|
||||
|
||||
if ( !$found_arg && $pos == $len ) {
|
||||
PTDEBUG && _d("Did not find arg, looking for special cases");
|
||||
local $INPUT_RECORD_SEPARATOR = ";\n";
|
||||
local $INPUT_RECORD_SEPARATOR = ";\n"; # get next line
|
||||
if ( defined(my $l = $next_event->()) ) {
|
||||
chomp $l;
|
||||
$l =~ s/^\s+//;
|
||||
PTDEBUG && _d("Found admin statement", $l);
|
||||
push @properties, 'cmd', 'Admin', 'arg', $l;
|
||||
push @properties, 'bytes', length($properties[-1]);
|
||||
$found_arg++;
|
||||
if ( $l =~ /^\s*[A-Z][a-z_]+: / ) {
|
||||
PTDEBUG && _d("Found NULL query before", $l);
|
||||
local $INPUT_RECORD_SEPARATOR = ";\n#";
|
||||
my $rest_of_event = $next_event->();
|
||||
push @{$self->{pending}}, $l . $rest_of_event;
|
||||
push @properties, 'cmd', 'Query', 'arg', '/* No query */';
|
||||
push @properties, 'bytes', 0;
|
||||
$found_arg++;
|
||||
}
|
||||
else {
|
||||
chomp $l;
|
||||
$l =~ s/^\s+//;
|
||||
PTDEBUG && _d("Found admin statement", $l);
|
||||
push @properties, 'cmd', 'Admin', 'arg', $l;
|
||||
push @properties, 'bytes', length($properties[-1]);
|
||||
$found_arg++;
|
||||
}
|
||||
}
|
||||
else {
|
||||
PTDEBUG && _d("I can't figure out what to do with this line");
|
||||
@@ -1890,7 +1908,8 @@ sub parse_event {
|
||||
$cmd = $arg;
|
||||
}
|
||||
else {
|
||||
my ($user, undef, $db) = $arg =~ /(\S+)/g;
|
||||
my ($user) = $arg =~ m/(\S+)/;
|
||||
my ($db) = $arg =~ m/on (\S+)/;
|
||||
my $host;
|
||||
($user, $host) = split(/@/, $user);
|
||||
PTDEBUG && _d('Connect', $user, '@', $host, 'on', $db);
|
||||
|
@@ -533,10 +533,16 @@ sub serialize_list {
|
||||
|
||||
return $args[0] if @args == 1 && !defined $args[0];
|
||||
|
||||
die "Cannot serialize multiple values with undef/NULL"
|
||||
if grep { !defined $_ } @args;
|
||||
|
||||
return join ',', map { quotemeta } @args;
|
||||
return join ',', map {
|
||||
my $c = $_;
|
||||
if ( defined($c) ) {
|
||||
$c =~ s/([^A-Za-z0-9])/\\$1/g;
|
||||
$c
|
||||
}
|
||||
else {
|
||||
'\\N'
|
||||
}
|
||||
} @args;
|
||||
}
|
||||
|
||||
sub deserialize_list {
|
||||
@@ -558,14 +564,15 @@ sub deserialize_list {
|
||||
|
||||
my @unescaped_parts = map {
|
||||
my $part = $_;
|
||||
|
||||
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;
|
||||
if ($part eq '\\N') {
|
||||
undef
|
||||
}
|
||||
else {
|
||||
$part =~ s/\\([^A-Za-z0-9])/$1/g;
|
||||
$part;
|
||||
}
|
||||
} @escaped_parts;
|
||||
|
||||
|
||||
return @unescaped_parts;
|
||||
}
|
||||
|
||||
|
@@ -129,10 +129,16 @@ sub serialize_list {
|
||||
|
||||
return $args[0] if @args == 1 && !defined $args[0];
|
||||
|
||||
die "Cannot serialize multiple values with undef/NULL"
|
||||
if grep { !defined $_ } @args;
|
||||
|
||||
return join ',', map { quotemeta } @args;
|
||||
return join ',', map {
|
||||
my $c = $_;
|
||||
if ( defined($c) ) {
|
||||
$c =~ s/([^A-Za-z0-9])/\\$1/g;
|
||||
$c
|
||||
}
|
||||
else {
|
||||
'\\N'
|
||||
}
|
||||
} @args;
|
||||
}
|
||||
|
||||
sub deserialize_list {
|
||||
@@ -154,14 +160,15 @@ sub deserialize_list {
|
||||
|
||||
my @unescaped_parts = map {
|
||||
my $part = $_;
|
||||
|
||||
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;
|
||||
if ($part eq '\\N') {
|
||||
undef
|
||||
}
|
||||
else {
|
||||
$part =~ s/\\([^A-Za-z0-9])/$1/g;
|
||||
$part;
|
||||
}
|
||||
} @escaped_parts;
|
||||
|
||||
|
||||
return @unescaped_parts;
|
||||
}
|
||||
|
||||
|
@@ -3527,10 +3527,16 @@ sub serialize_list {
|
||||
|
||||
return $args[0] if @args == 1 && !defined $args[0];
|
||||
|
||||
die "Cannot serialize multiple values with undef/NULL"
|
||||
if grep { !defined $_ } @args;
|
||||
|
||||
return join ',', map { quotemeta } @args;
|
||||
return join ',', map {
|
||||
my $c = $_;
|
||||
if ( defined($c) ) {
|
||||
$c =~ s/([^A-Za-z0-9])/\\$1/g;
|
||||
$c
|
||||
}
|
||||
else {
|
||||
'\\N'
|
||||
}
|
||||
} @args;
|
||||
}
|
||||
|
||||
sub deserialize_list {
|
||||
@@ -3552,14 +3558,15 @@ sub deserialize_list {
|
||||
|
||||
my @unescaped_parts = map {
|
||||
my $part = $_;
|
||||
|
||||
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;
|
||||
if ($part eq '\\N') {
|
||||
undef
|
||||
}
|
||||
else {
|
||||
$part =~ s/\\([^A-Za-z0-9])/$1/g;
|
||||
$part;
|
||||
}
|
||||
} @escaped_parts;
|
||||
|
||||
|
||||
return @unescaped_parts;
|
||||
}
|
||||
|
||||
|
@@ -1620,10 +1620,16 @@ sub serialize_list {
|
||||
|
||||
return $args[0] if @args == 1 && !defined $args[0];
|
||||
|
||||
die "Cannot serialize multiple values with undef/NULL"
|
||||
if grep { !defined $_ } @args;
|
||||
|
||||
return join ',', map { quotemeta } @args;
|
||||
return join ',', map {
|
||||
my $c = $_;
|
||||
if ( defined($c) ) {
|
||||
$c =~ s/([^A-Za-z0-9])/\\$1/g;
|
||||
$c
|
||||
}
|
||||
else {
|
||||
'\\N'
|
||||
}
|
||||
} @args;
|
||||
}
|
||||
|
||||
sub deserialize_list {
|
||||
@@ -1645,14 +1651,15 @@ sub deserialize_list {
|
||||
|
||||
my @unescaped_parts = map {
|
||||
my $part = $_;
|
||||
|
||||
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;
|
||||
if ($part eq '\\N') {
|
||||
undef
|
||||
}
|
||||
else {
|
||||
$part =~ s/\\([^A-Za-z0-9])/$1/g;
|
||||
$part;
|
||||
}
|
||||
} @escaped_parts;
|
||||
|
||||
|
||||
return @unescaped_parts;
|
||||
}
|
||||
|
||||
@@ -7521,11 +7528,16 @@ sub next {
|
||||
|
||||
if ( !$self->{initialized} ) {
|
||||
$self->{initialized} = 1;
|
||||
if ( $self->{resume}->{tbl}
|
||||
&& !$self->table_is_allowed(@{$self->{resume}}{qw(db tbl)}) ) {
|
||||
PTDEBUG && _d('Will resume after',
|
||||
join('.', @{$self->{resume}}{qw(db tbl)}));
|
||||
$self->{resume}->{after} = 1;
|
||||
if ( $self->{resume}->{tbl} ) {
|
||||
if ( !$self->table_is_allowed(@{$self->{resume}}{qw(db tbl)}) ) {
|
||||
PTDEBUG && _d('Will resume after',
|
||||
join('.', @{$self->{resume}}{qw(db tbl)}));
|
||||
$self->{resume}->{after}->{tbl} = 1;
|
||||
}
|
||||
if ( !$self->database_is_allowed($self->{resume}->{db}) ) {
|
||||
PTDEBUG && _d('Will resume after', $self->{resume}->{db});
|
||||
$self->{resume}->{after}->{db} = 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@@ -7623,16 +7635,17 @@ sub _iterate_dbh {
|
||||
if ( !defined $self->{dbs} ) {
|
||||
my $sql = 'SHOW DATABASES';
|
||||
PTDEBUG && _d($sql);
|
||||
my @dbs = grep { $self->database_is_allowed($_) }
|
||||
@{$dbh->selectcol_arrayref($sql)};
|
||||
my @dbs = grep {
|
||||
$self->_resume_from_database($_)
|
||||
&&
|
||||
$self->database_is_allowed($_)
|
||||
} @{$dbh->selectcol_arrayref($sql)};
|
||||
PTDEBUG && _d('Found', scalar @dbs, 'databases');
|
||||
$self->{dbs} = \@dbs;
|
||||
}
|
||||
|
||||
if ( !$self->{db} ) {
|
||||
do {
|
||||
$self->{db} = shift @{$self->{dbs}};
|
||||
} until $self->_resume_from_database($self->{db});
|
||||
$self->{db} = shift @{$self->{dbs}};
|
||||
PTDEBUG && _d('Next database:', $self->{db});
|
||||
return unless $self->{db};
|
||||
}
|
||||
@@ -7805,11 +7818,17 @@ sub _resume_from_database {
|
||||
my ($self, $db) = @_;
|
||||
|
||||
return 1 unless $self->{resume}->{db};
|
||||
|
||||
if ( $db eq $self->{resume}->{db} ) {
|
||||
PTDEBUG && _d('At resume db', $db);
|
||||
delete $self->{resume}->{db};
|
||||
return 1;
|
||||
if ( !$self->{resume}->{after}->{db} ) {
|
||||
PTDEBUG && _d('Resuming from db', $db);
|
||||
delete $self->{resume}->{db};
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
PTDEBUG && _d('Resuming after db', $db);
|
||||
delete $self->{resume}->{db};
|
||||
delete $self->{resume}->{tbl};
|
||||
}
|
||||
}
|
||||
|
||||
return 0;
|
||||
@@ -7821,7 +7840,7 @@ sub _resume_from_table {
|
||||
return 1 unless $self->{resume}->{tbl};
|
||||
|
||||
if ( $tbl eq $self->{resume}->{tbl} ) {
|
||||
if ( !$self->{resume}->{after} ) {
|
||||
if ( !$self->{resume}->{after}->{tbl} ) {
|
||||
PTDEBUG && _d('Resuming from table', $tbl);
|
||||
delete $self->{resume}->{tbl};
|
||||
return 1;
|
||||
|
@@ -938,10 +938,16 @@ sub serialize_list {
|
||||
|
||||
return $args[0] if @args == 1 && !defined $args[0];
|
||||
|
||||
die "Cannot serialize multiple values with undef/NULL"
|
||||
if grep { !defined $_ } @args;
|
||||
|
||||
return join ',', map { quotemeta } @args;
|
||||
return join ',', map {
|
||||
my $c = $_;
|
||||
if ( defined($c) ) {
|
||||
$c =~ s/([^A-Za-z0-9])/\\$1/g;
|
||||
$c
|
||||
}
|
||||
else {
|
||||
'\\N'
|
||||
}
|
||||
} @args;
|
||||
}
|
||||
|
||||
sub deserialize_list {
|
||||
@@ -963,14 +969,15 @@ sub deserialize_list {
|
||||
|
||||
my @unescaped_parts = map {
|
||||
my $part = $_;
|
||||
|
||||
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;
|
||||
if ($part eq '\\N') {
|
||||
undef
|
||||
}
|
||||
else {
|
||||
$part =~ s/\\([^A-Za-z0-9])/$1/g;
|
||||
$part;
|
||||
}
|
||||
} @escaped_parts;
|
||||
|
||||
|
||||
return @unescaped_parts;
|
||||
}
|
||||
|
||||
@@ -2498,14 +2505,25 @@ sub parse_event {
|
||||
|
||||
if ( !$found_arg && $pos == $len ) {
|
||||
PTDEBUG && _d("Did not find arg, looking for special cases");
|
||||
local $INPUT_RECORD_SEPARATOR = ";\n";
|
||||
local $INPUT_RECORD_SEPARATOR = ";\n"; # get next line
|
||||
if ( defined(my $l = $next_event->()) ) {
|
||||
chomp $l;
|
||||
$l =~ s/^\s+//;
|
||||
PTDEBUG && _d("Found admin statement", $l);
|
||||
push @properties, 'cmd', 'Admin', 'arg', $l;
|
||||
push @properties, 'bytes', length($properties[-1]);
|
||||
$found_arg++;
|
||||
if ( $l =~ /^\s*[A-Z][a-z_]+: / ) {
|
||||
PTDEBUG && _d("Found NULL query before", $l);
|
||||
local $INPUT_RECORD_SEPARATOR = ";\n#";
|
||||
my $rest_of_event = $next_event->();
|
||||
push @{$self->{pending}}, $l . $rest_of_event;
|
||||
push @properties, 'cmd', 'Query', 'arg', '/* No query */';
|
||||
push @properties, 'bytes', 0;
|
||||
$found_arg++;
|
||||
}
|
||||
else {
|
||||
chomp $l;
|
||||
$l =~ s/^\s+//;
|
||||
PTDEBUG && _d("Found admin statement", $l);
|
||||
push @properties, 'cmd', 'Admin', 'arg', $l;
|
||||
push @properties, 'bytes', length($properties[-1]);
|
||||
$found_arg++;
|
||||
}
|
||||
}
|
||||
else {
|
||||
PTDEBUG && _d("I can't figure out what to do with this line");
|
||||
|
Reference in New Issue
Block a user