|
Lines 3-17
Link Here
|
| 3 |
use strict; |
3 |
use strict; |
| 4 |
use warnings; |
4 |
use warnings; |
| 5 |
|
5 |
|
| 6 |
use Test::More tests => 25; |
6 |
use Test::More tests => 32; |
|
|
7 |
use Test::Warn; |
| 7 |
BEGIN { |
8 |
BEGIN { |
| 8 |
diag " |
9 |
diag q{ |
| 9 |
This test demonstrates why Koha uses the CSV parser and configration it does. |
10 |
This test demonstrates why Koha uses the CSV parser and configration |
| 10 |
Specifically, the test is for Unicode compliance in text parsing and data. |
11 |
it does. Specifically, the test is for Unicode compliance in text |
| 11 |
This test requires other modules that Koha doesn't actually use, in order to compare. |
12 |
parsing and data. This test requires other modules that Koha doesn't |
| 12 |
Therefore, running this test is not necessary to test your Koha installation. |
13 |
actually use, in order to compare. Therefore, running this test is not |
| 13 |
|
14 |
necessary to test your Koha installation. |
| 14 |
"; |
15 |
}; |
| 15 |
use FindBin; |
16 |
use FindBin; |
| 16 |
use lib $FindBin::Bin; |
17 |
use lib $FindBin::Bin; |
| 17 |
use_ok('Text::CSV'); |
18 |
use_ok('Text::CSV'); |
|
Lines 42-48
my $lines = [
Link Here
|
| 42 |
]; |
43 |
]; |
| 43 |
# 010D: č LATIN SMALL LETTER C WITH CARON |
44 |
# 010D: č LATIN SMALL LETTER C WITH CARON |
| 44 |
# 0117: ė LATIN SMALL LETTER E WITH DOT ABOVE |
45 |
# 0117: ė LATIN SMALL LETTER E WITH DOT ABOVE |
| 45 |
diag sprintf "Testing %d lines with %d parsers.", scalar(@$lines), scalar(keys %parsers); |
46 |
ok( scalar(keys %parsers)>0 && scalar(@$lines)>0, |
|
|
47 |
sprintf "Testing %d lines with %d parsers.", |
| 48 |
scalar(@$lines), scalar(keys %parsers) ); |
| 46 |
foreach my $key (sort keys %parsers) { |
49 |
foreach my $key (sort keys %parsers) { |
| 47 |
my $parser = $parsers{$key}; |
50 |
my $parser = $parsers{$key}; |
| 48 |
print "Testing parser $key version " . ($parser->version||'?') . "\n"; |
51 |
print "Testing parser $key version " . ($parser->version||'?') . "\n"; |
|
Lines 54-68
LINE: foreach (@$lines) {
Link Here
|
| 54 |
foreach my $key (sort keys %parsers) { |
57 |
foreach my $key (sort keys %parsers) { |
| 55 |
my $parser = $parsers{$key}; |
58 |
my $parser = $parsers{$key}; |
| 56 |
my ($status,$count,@fields); |
59 |
my ($status,$count,@fields); |
| 57 |
ok($status = $parser->parse($_->{line}), "parse ($key)"); |
60 |
$status = $parser->parse($_->{line}); |
| 58 |
if ($status) { |
61 |
if ($status) { |
|
|
62 |
ok($status, "parse ($key)"); |
| 59 |
@fields = $parser->fields; |
63 |
@fields = $parser->fields; |
| 60 |
ok(($count = scalar(@fields)) == 6, "Number of fields ($count of 6)"); |
64 |
ok(($count = scalar(@fields)) == 6, "Number of fields ($count of 6)"); |
| 61 |
my $j = 0; |
65 |
my $j = 0; |
| 62 |
foreach my $f (@fields) { |
66 |
foreach my $f (@fields) { |
| 63 |
print "\t field " . ++$j . ": $f\n"; |
67 |
++$j; |
|
|
68 |
if ($j==4) { |
| 69 |
if ($key ne 'Text::CSV::Unicode (binary)') { |
| 70 |
warning_like { |
| 71 |
print "\t field " . $j . ": $f\n" |
| 72 |
} [ qr/Wide character in print/ ], 'Expected wide print'; |
| 73 |
} else { |
| 74 |
print "\t field " . $j . ": $f\n" |
| 75 |
} |
| 76 |
} |
| 77 |
else { |
| 78 |
print "\t field " . $j . ": $f\n"; |
| 79 |
} |
| 64 |
} |
80 |
} |
| 65 |
} |
81 |
} |
|
|
82 |
else { |
| 83 |
ok(! $status, "parse ($key) fails as expected"); |
| 84 |
} |
| 66 |
} |
85 |
} |
| 67 |
} |
86 |
} |
| 68 |
diag "done.\n"; |
87 |
done_testing(); |
| 69 |
- |
|
|