percona/percona-toolkit
1
0
Fork 0
mirror of https://github.com/percona/percona-toolkit.git synced 2026-03-07 02:00:50 +08:00
Code Issues Packages Projects Releases Wiki Activity

Adjust code spacing, tweak comments, do only (de)serialize tests with database, give tests names.

Browse Source
This commit is contained in:
Daniel Nichter
2011-12-28 15:47:50 -07:00
parent 88e82d665d
commit 4197b09f53
2 changed files with 55 additions and 51 deletions
Download Patch File Download Diff File Expand all files Collapse all files

69
lib/Quoter.pm
View File

@@ -144,11 +144,10 @@ sub join_quote {
return $db ? "$db.$tbl" : $tbl;
}
# Nothing much going on here. Return the list passed in,
# with the elements passed through quotemeta, and the results
# concatenated with ','
# Return the list passed in, with the elements passed through quotemeta,
# and the results concatenated with ','.
sub serialize_list {
my @args = @_;
my ( $self, @args ) = @_;
if ( @args && $args[-1] eq '' ) {
# If the last element is an empty string, it conflicts
# with the assumptions of the somewhat lax regex below,
@@ -163,49 +162,49 @@ sub serialize_list {
}
sub deserialize_list {
my ( $string ) = @_;
my @escaped_parts = $string =~ /
my ( $self, $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 means we can continue
\\. # A backslash followed by something so we can continue
[^\\,]* # Same as above.
)* # Repeat zero of more times.
)
(?:,|\z) # Comma dividing elements, or absolute end of the string.
(?:,|\z) # Comma dividing elements or absolute end of the string.
/sxg;
pop @escaped_parts; # Last element will always be empty. Flaw in the regex.
# But easier to fix this way. Faster, too.
my @unescaped_parts = map {
# Undo the quotemeta().
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.
# 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;
# As a somewhat uplifting note, all of the above is more
# or less fixed in newer Perls! quotemeta() is still
# broken, but regexen can deal with it more naturally.
$part;
} @escaped_parts;
# Last element will always be empty. Flaw in the regex.
# But easier to fix this way. Faster, too.
pop @escaped_parts;
# 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.
# 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;
return @unescaped_parts;
}
1;
}
# ###########################################################################

37
t/lib/Quoter.t
View File

@@ -9,7 +9,7 @@ BEGIN {
use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use Test::More tests => 63;
use Test::More tests => 47;
use Quoter;
use PerconaTest;
@@ -99,6 +99,10 @@ is( $q->join_quote('`db`', '`tbl`'), '`db`.`tbl`', 'join_merge(`db`, `tbl`)' );
is( $q->join_quote(undef, '`tbl`'), '`tbl`', 'join_merge(undef, `tbl`)' );
is( $q->join_quote('`db`', '`foo`.`tbl`'), '`foo`.`tbl`', 'join_merge(`db`, `foo`.`tbl`)' );
# ###########################################################################
# (de)serialize_list
# ###########################################################################
my @serialize_tests = (
[ 'a', 'b', ],
[ 'a,', 'b', ],
@@ -118,22 +122,17 @@ my @serialize_tests = (
[ '', '', '', ],
);
for my $test ( @serialize_tests ) {
my $ser = Quoter::serialize_list( @$test );
is_deeply(
[Quoter::deserialize_list($ser)],
$test,
"serialize then deserialize works"
);
}
use DSNParser;
use Sandbox;
my $dp = new DSNParser(opts=>$dsn_opts);
my $sb = new Sandbox(basedir => '/tmp', DSNParser => $dp);
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', 1 unless $dbh;
skip 'Cannot connect to sandbox master', scalar @serialize_tests unless $dbh;
# Prevent "Wide character in print at Test/Builder.pm" warnings.
binmode Test::More->builder->$_(), ':encoding(UTF-8)'
for qw(output failure_output);
$dbh->do('CREATE DATABASE IF NOT EXISTS serialize_test');
$dbh->do('DROP TABLE IF EXISTS serialize_test.serialize');
@@ -147,7 +146,7 @@ SKIP: {
);
for my $test_index ( 0..$#serialize_tests ) {
my $ser = Quoter::serialize_list( @{$serialize_tests[$test_index]} );
my $ser = $q->serialize_list( @{$serialize_tests[$test_index]} );
# Bit of a hack, but we want to test both of Perl's internal encodings
# for correctness.
@@ -156,10 +155,13 @@ SKIP: {
$sth->execute($test_index, $ser);
$selsth->execute($test_index);
my $flat_string = "@{$serialize_tests[$test_index]}";
$flat_string =~ s/\n/\\n/g;
is_deeply(
[Quoter::deserialize_list($selsth->fetchrow_array())],
[ $q->deserialize_list($selsth->fetchrow_array()) ],
$serialize_tests[$test_index],
"serialize then deserialize through the DB works"
"Serialize $flat_string"
);
}
@@ -171,4 +173,7 @@ SKIP: {
$dbh->disconnect();
};
# ###########################################################################
# Done.
# ###########################################################################
exit;