xt/author/Text_CSV_Various.t

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