View | Details | Raw Unified | Return to bug 31590
Collapse All | Expand All

(-)a/cpanfile (-1 lines)
Lines 173-179 recommends 'Test::Strict', '0.14'; Link Here
173
recommends 'Test::WWW::Mechanize', '1.42';
173
recommends 'Test::WWW::Mechanize', '1.42';
174
recommends 'Test::Warn', '0.21';
174
recommends 'Test::Warn', '0.21';
175
recommends 'Test::YAML::Valid', '0.04';
175
recommends 'Test::YAML::Valid', '0.04';
176
recommends 'Text::CSV::Unicode', '0.40';
177
recommends 'Text::Unidecode', '0.04';
176
recommends 'Text::Unidecode', '0.04';
178
recommends 'Time::Fake', '0.11';
177
recommends 'Time::Fake', '0.11';
179
recommends 'UNIVERSAL::require', '0.13';
178
recommends 'UNIVERSAL::require', '0.13';
(-)a/tools/import_borrowers.pl (-4 lines)
Lines 52-61 my $Import = Koha::Patrons::Import->new(); Link Here
52
52
53
use Text::CSV;
53
use Text::CSV;
54
54
55
# Text::CSV::Unicode, even in binary mode, fails to parse lines with these diacriticals:
56
# ė
57
# č
58
59
use CGI qw ( -utf8 );
55
use CGI qw ( -utf8 );
60
56
61
my $extended = C4::Context->preference('ExtendedPatronAttributes');
57
my $extended = C4::Context->preference('ExtendedPatronAttributes');
(-)a/xt/author/Text_CSV_Various.t (-42 / +18 lines)
Lines 21-45 Link Here
21
#necessary to test your Koha installation.
21
#necessary to test your Koha installation.
22
22
23
use Modern::Perl;
23
use Modern::Perl;
24
use open OUT=>':encoding(UTF-8)', ':std';
25
use utf8;
24
26
25
use Test::More;
27
use Test::More tests => 21;
26
use Test::Warn;
27
28
use Text::CSV;
28
use Text::CSV;
29
use Text::CSV_XS;
29
use Text::CSV_XS;
30
30
31
use Module::Load::Conditional qw/check_install/;
32
33
BEGIN {
34
    if ( check_install( module => 'Text::CSV::Unicode' ) ) {
35
        plan tests => 29;
36
    } else {
37
        plan skip_all => "Need Text::CSV::Unicode"
38
    }
39
}
40
41
use Text::CSV::Unicode;
42
43
sub pretty_line {
31
sub pretty_line {
44
	my $max = 54;
32
	my $max = 54;
45
	(@_) or return "#" x $max . "\n";
33
	(@_) or return "#" x $max . "\n";
Lines 50-56 sub pretty_line { Link Here
50
38
51
my ($csv, $bin, %parsers);
39
my ($csv, $bin, %parsers);
52
40
53
foreach(qw(Text::CSV Text::CSV_XS Text::CSV::Unicode)) {
41
foreach( qw( Text::CSV Text::CSV_XS )) {
54
    ok($csv = $_->new(),            $_ . '->new()');
42
    ok($csv = $_->new(),            $_ . '->new()');
55
    ok($bin = $_->new({binary=>1}), $_ . '->new({binary=>1})');
43
    ok($bin = $_->new({binary=>1}), $_ . '->new({binary=>1})');
56
    $csv and $parsers{$_} = $csv;
44
    $csv and $parsers{$_} = $csv;
Lines 61-107 my $lines = [ Link Here
61
    {description=>"010D: LATIN SMALL LETTER C WITH CARON",     character=>'č', line=>'field1,second field,field3,do_we_have_a_č_problem?, f!fth field ,lastfield'},
49
    {description=>"010D: LATIN SMALL LETTER C WITH CARON",     character=>'č', line=>'field1,second field,field3,do_we_have_a_č_problem?, f!fth field ,lastfield'},
62
    {description=>"0117: LATIN SMALL LETTER E WITH DOT ABOVE", character=>'ė', line=>'field1,second field,field3,do_we_have_a_ė_problem?, f!fth field ,lastfield'},
50
    {description=>"0117: LATIN SMALL LETTER E WITH DOT ABOVE", character=>'ė', line=>'field1,second field,field3,do_we_have_a_ė_problem?, f!fth field ,lastfield'},
63
];
51
];
64
# 010D: č LATIN SMALL LETTER C WITH CARON
52
65
# 0117: ė LATIN SMALL LETTER E WITH DOT ABOVE
66
ok( scalar(keys %parsers)>0 && scalar(@$lines)>0,
53
ok( scalar(keys %parsers)>0 && scalar(@$lines)>0,
67
    sprintf "Testing %d lines with  %d parsers.",
54
    sprintf "Testing %d lines with  %d parsers.",
68
         scalar(@$lines), scalar(keys %parsers) );
55
         scalar(@$lines), scalar(keys %parsers) );
56
69
foreach my $key (sort keys %parsers) {
57
foreach my $key (sort keys %parsers) {
70
    my $parser = $parsers{$key};
58
    my $parser = $parsers{$key};
71
    print "Testing parser $key version " . ($parser->version||'?') . "\n";
59
    print "Testing parser $key version " . ($parser->version||'?') . "\n";
72
}
60
}
61
73
my $i = 0;
62
my $i = 0;
74
LINE: foreach (@$lines) {
63
foreach my $line (@$lines) {
75
    print pretty_line("Line " . ++$i);
64
    print pretty_line("Line " . ++$i);
76
    print pretty_line($_->{description} . ': ' . $_->{character});
65
    print pretty_line($line->{description} . ': ' . $line->{character});
77
    foreach my $key (sort keys %parsers) {
66
    foreach my $key (sort keys %parsers) {
78
        my $parser = $parsers{$key};
67
        my $parser = $parsers{$key};
79
        my ($status,$count,@fields);
68
        my ($status, $count, @fields);
80
        $status = $parser->parse($_->{line});
69
        $status = $parser->parse( $line->{line} );
81
        if ($status) {
70
        if( $status ) {
82
            ok($status, "parse ($key)");
71
            ok($status, "parse ($key)");
83
            @fields = $parser->fields;
72
            @fields = $parser->fields;
84
            ok(($count = scalar(@fields)) == 6, "Number of fields ($count of 6)");
73
            $count = scalar(@fields);
74
            is( $count, 6, "Number of fields ($count of 6)");
85
            my $j = 0;
75
            my $j = 0;
86
            foreach my $f (@fields) {
76
            foreach my $f (@fields) {
87
                ++$j;
77
                $j++;
88
                if ($j==4) {
78
                print "\t field $j: $f\n";
89
                    if ($key ne 'Text::CSV::Unicode (binary)') {
90
                        warning_like {
91
                            print "\t field " . $j . ": $f\n"
92
                        } [ qr/Wide character in print/ ], 'Expected wide print';
93
                    } else {
94
                        print "\t field " . $j . ": $f\n"
95
                    }
96
                }
97
                else {
98
                    print "\t field " . $j . ": $f\n";
99
                }
100
            }
79
            }
101
        }
80
        } else {
102
        else {
81
            ok(! $status, "parse ($key) fails as expected"); #FIXME We never hit this line
103
            ok(! $status, "parse ($key) fails as expected");
104
        }
82
        }
105
    }
83
    }
106
}
84
}
107
done_testing();
108
- 

Return to bug 31590