Attachment #140817 for bug #31590

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

Lines 173-179 recommends 'Test::Strict', '0.14'; Link Here

(-)a/cpanfile (-1 lines)
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';

Lines 52-61 my $Import = Koha::Patrons::Import->new(); Link Here

(-)a/tools/import_borrowers.pl (-4 lines)
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');




#necessary to test your Koha installation.

use Modern::Perl;
use open OUT=>':encoding(UTF-8)', ':std';
use utf8;

use Test::More tests => 21;
use Test::Warn;

use Text::CSV;
use Text::CSV_XS;

use Module::Load::Conditional qw/check_install/;

BEGIN {
    if ( check_install( module => 'Text::CSV::Unicode' ) ) {
        plan tests => 29;
    } else {
        plan skip_all => "Need Text::CSV::Unicode"
    }
}

use Text::CSV::Unicode;

sub pretty_line {
	my $max = 54;
	(@_) or return "#" x $max . "\n";


my ($csv, $bin, %parsers);

foreach( qw( Text::CSV Text::CSV_XS )) {
    ok($csv = $_->new(),            $_ . '->new()');
    ok($bin = $_->new({binary=>1}), $_ . '->new({binary=>1})');
    $csv and $parsers{$_} = $csv;

    {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'},
];

# 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;
foreach my $line (@$lines) {
    print pretty_line("Line " . ++$i);
    print pretty_line($line->{description} . ': ' . $line->{character});
    foreach my $key (sort keys %parsers) {
        my $parser = $parsers{$key};
        my ($status, $count, @fields);
        $status = $parser->parse( $line->{line} );
        if( $status ) {
            ok($status, "parse ($key)");
            @fields = $parser->fields;
            $count = scalar(@fields);
            is( $count, 6, "Number of fields ($count of 6)");
            my $j = 0;
            foreach my $f (@fields) {
                $j++;
                print "\t field $j: $f\n";
                    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"); #FIXME We never hit this line
            ok(! $status, "parse ($key) fails as expected");
        }
    }
}
done_testing();
- 

Return to bug 31590

Lines 21-45 Link Here

(-)a/xt/author/Text_CSV_Various.t (-42 / +18 lines)
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	-