xt/author/Text_CSV_Various.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 32;
   7 use Test::Warn;
   8 BEGIN {
   9     diag q{
  10 This test demonstrates why Koha uses the CSV parser and configration
  11 it does.  Specifically, the test is for Unicode compliance in text
  12 parsing and data.  This test requires other modules that Koha doesn't
  13 actually use, in order to compare.  Therefore, running this test is not
  14 necessary to test your Koha installation.
  15 };
  16         use FindBin;
  17         use lib $FindBin::Bin;
  18         use_ok('Text::CSV');
  19         use_ok('Text::CSV_XS');
  20         use_ok('Text::CSV::Unicode');
  21 }
  22
  23 sub pretty_line {
  24         my $max = 54;
  25         (@_) or return "#" x $max . "\n";
  26         my $phrase = "  " . shift() . "  ";
  27         my $half = "#" x (($max - length($phrase))/2);
  28         return $half . $phrase . $half . "\n";
  29 }
  30
  31 my ($csv, $bin, %parsers);
  32
  33 foreach(qw(Text::CSV Text::CSV_XS Text::CSV::Unicode)) {
  34     ok($csv = $_->new(),            $_ . '->new()');
  35     ok($bin = $_->new({binary=>1}), $_ . '->new({binary=>1})');
  36     $csv and $parsers{$_} = $csv;
  37     $bin and $parsers{$_ . " (binary)"} = $bin;
  38 }
  39
  40 my $lines = [
  41     {description=>"010D: LATIN SMALL LETTER C WITH CARON",     character=>'č', line=>'field1,second field,field3,do_we_have_a_č_problem?, f!fth field ,lastfield'},
  42     {description=>"0117: LATIN SMALL LETTER E WITH DOT ABOVE", character=>'ė', line=>'field1,second field,field3,do_we_have_a_ė_problem?, f!fth field ,lastfield'},
  43 ];
  44 # 010D: č LATIN SMALL LETTER C WITH CARON
  45 # 0117: ė LATIN SMALL LETTER E WITH DOT ABOVE
  46 ok( scalar(keys %parsers)>0 && scalar(@$lines)>0,
  47     sprintf "Testing %d lines with  %d parsers.",
  48          scalar(@$lines), scalar(keys %parsers) );
  49 foreach my $key (sort keys %parsers) {
  50     my $parser = $parsers{$key};
  51     print "Testing parser $key version " . ($parser->version||'?') . "\n";
  52 }
  53 my $i = 0;
  54 LINE: foreach (@$lines) {
  55     print pretty_line("Line " . ++$i);
  56     print pretty_line($_->{description} . ': ' . $_->{character});
  57     foreach my $key (sort keys %parsers) {
  58         my $parser = $parsers{$key};
  59         my ($status,$count,@fields);
  60         $status = $parser->parse($_->{line});
  61         if ($status) {
  62             ok($status, "parse ($key)");
  63             @fields = $parser->fields;
  64             ok(($count = scalar(@fields)) == 6, "Number of fields ($count of 6)");
  65             my $j = 0;
  66             foreach my $f (@fields) {
  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                 }
  80             }
  81         }
  82         else {
  83             ok(! $status, "parse ($key) fails as expected");
  84         }
  85     }
  86 }
  87 done_testing();