Update all modules that use Quoter

This commit is contained in:
Brian Fraser
2012-12-12 16:19:06 -03:00
parent dcc66e8a32
commit 9512f631c9
15 changed files with 407 additions and 232 deletions

View File

@@ -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;
}

View File

@@ -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;
}

View File

@@ -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;

View File

@@ -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;
}

View File

@@ -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;
}

View File

@@ -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;
}

View File

@@ -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;

View File

@@ -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;
}

View File

@@ -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;
}

View File

@@ -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);

View File

@@ -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;
}

View File

@@ -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;
}

View File

@@ -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;
}

View File

@@ -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;

View File

@@ -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");