89d36585bb
While it might be an idea to just delete it, this patch attempts to catch everything and make it clear that Text::CSV::Unicode (binary) is the parser that should be used. Signed-off-by: Lee Jamison <ldjamison@marywood.edu> Running 'prove xt/author/Text_CSV_Various.t' passes Signed-off-by: Jonathan Druart <jonathan.druart@bugs.koha-community.org>
87 lines
2.9 KiB
Perl
Executable file
87 lines
2.9 KiB
Perl
Executable file
#!/usr/bin/perl
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Test::More tests => 32;
|
|
use Test::Warn;
|
|
BEGIN {
|
|
diag q{
|
|
This test demonstrates why Koha uses the CSV parser and configration
|
|
it does. Specifically, the test is for Unicode compliance in text
|
|
parsing and data. This test requires other modules that Koha doesn't
|
|
actually use, in order to compare. Therefore, running this test is not
|
|
necessary to test your Koha installation.
|
|
};
|
|
use FindBin;
|
|
use lib $FindBin::Bin;
|
|
use_ok('Text::CSV');
|
|
use_ok('Text::CSV_XS');
|
|
use_ok('Text::CSV::Unicode');
|
|
}
|
|
|
|
sub pretty_line {
|
|
my $max = 54;
|
|
(@_) or return "#" x $max . "\n";
|
|
my $phrase = " " . shift() . " ";
|
|
my $half = "#" x (($max - length($phrase))/2);
|
|
return $half . $phrase . $half . "\n";
|
|
}
|
|
|
|
my ($csv, $bin, %parsers);
|
|
|
|
foreach(qw(Text::CSV Text::CSV_XS Text::CSV::Unicode)) {
|
|
ok($csv = $_->new(), $_ . '->new()');
|
|
ok($bin = $_->new({binary=>1}), $_ . '->new({binary=>1})');
|
|
$csv and $parsers{$_} = $csv;
|
|
$bin and $parsers{$_ . " (binary)"} = $bin;
|
|
}
|
|
|
|
my $lines = [
|
|
{description=>"010D: LATIN SMALL LETTER C WITH CARON", character=>'č', line=>'field1,second field,field3,do_we_have_a_č_problem?, f!fth field ,lastfield'},
|
|
{description=>"0117: LATIN SMALL LETTER E WITH DOT ABOVE", character=>'ė', line=>'field1,second field,field3,do_we_have_a_ė_problem?, f!fth field ,lastfield'},
|
|
];
|
|
# 010D: č LATIN SMALL LETTER C WITH CARON
|
|
# 0117: ė LATIN SMALL LETTER E WITH DOT ABOVE
|
|
ok( scalar(keys %parsers)>0 && scalar(@$lines)>0,
|
|
sprintf "Testing %d lines with %d parsers.",
|
|
scalar(@$lines), scalar(keys %parsers) );
|
|
foreach my $key (sort keys %parsers) {
|
|
my $parser = $parsers{$key};
|
|
print "Testing parser $key version " . ($parser->version||'?') . "\n";
|
|
}
|
|
my $i = 0;
|
|
LINE: foreach (@$lines) {
|
|
print pretty_line("Line " . ++$i);
|
|
print pretty_line($_->{description} . ': ' . $_->{character});
|
|
foreach my $key (sort keys %parsers) {
|
|
my $parser = $parsers{$key};
|
|
my ($status,$count,@fields);
|
|
$status = $parser->parse($_->{line});
|
|
if ($status) {
|
|
ok($status, "parse ($key)");
|
|
@fields = $parser->fields;
|
|
ok(($count = scalar(@fields)) == 6, "Number of fields ($count of 6)");
|
|
my $j = 0;
|
|
foreach my $f (@fields) {
|
|
++$j;
|
|
if ($j==4) {
|
|
if ($key ne 'Text::CSV::Unicode (binary)') {
|
|
warning_like {
|
|
print "\t field " . $j . ": $f\n"
|
|
} [ qr/Wide character in print/ ], 'Expected wide print';
|
|
} else {
|
|
print "\t field " . $j . ": $f\n"
|
|
}
|
|
}
|
|
else {
|
|
print "\t field " . $j . ": $f\n";
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
ok(! $status, "parse ($key) fails as expected");
|
|
}
|
|
}
|
|
}
|
|
done_testing();
|