xt/author/Text_CSV_Various.t

   1 #!/usr/bin/perl
   2
   3 # This file is part of Koha.
   4 #
   5 # Koha is free software; you can redistribute it and/or modify it under the
   6 # terms of the GNU General Public License as published by the Free Software
   7 # Foundation; either version 3 of the License, or (at your option) any later
   8 # version.
   9 #
  10 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  11 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  12 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License along
  15 # with Koha; if not, see <http://www.gnu.org/licenses>.
  16
  17 #This test demonstrates why Koha uses the CSV parser and configration
  18 #it does.  Specifically, the test is for Unicode compliance in text
  19 #parsing and data.  This test requires other modules that Koha doesn't
  20 #actually use, in order to compare.  Therefore, running this test is not
  21 #necessary to test your Koha installation.
  22
  23 use Modern::Perl;
  24
  25 use Test::More;
  26 use Test::Warn;
  27
  28 use Text::CSV;
  29 use Text::CSV_XS;
  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 {
  44         my $max = 54;
  45         (@_) or return "#" x $max . "\n";
  46         my $phrase = "  " . shift() . "  ";
  47         my $half = "#" x (($max - length($phrase))/2);
  48         return $half . $phrase . $half . "\n";
  49 }
  50
  51 my ($csv, $bin, %parsers);
  52
  53 foreach(qw(Text::CSV Text::CSV_XS Text::CSV::Unicode)) {
  54     ok($csv = $_->new(),            $_ . '->new()');
  55     ok($bin = $_->new({binary=>1}), $_ . '->new({binary=>1})');
  56     $csv and $parsers{$_} = $csv;
  57     $bin and $parsers{$_ . " (binary)"} = $bin;
  58 }
  59
  60 my $lines = [
  61     {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'},
  63 ];
  64 # 010D: č LATIN SMALL LETTER C WITH CARON
  65 # 0117: ė LATIN SMALL LETTER E WITH DOT ABOVE
  66 ok( scalar(keys %parsers)>0 && scalar(@$lines)>0,
  67     sprintf "Testing %d lines with  %d parsers.",
  68          scalar(@$lines), scalar(keys %parsers) );
  69 foreach my $key (sort keys %parsers) {
  70     my $parser = $parsers{$key};
  71     print "Testing parser $key version " . ($parser->version||'?') . "\n";
  72 }
  73 my $i = 0;
  74 LINE: foreach (@$lines) {
  75     print pretty_line("Line " . ++$i);
  76     print pretty_line($_->{description} . ': ' . $_->{character});
  77     foreach my $key (sort keys %parsers) {
  78         my $parser = $parsers{$key};
  79         my ($status,$count,@fields);
  80         $status = $parser->parse($_->{line});
  81         if ($status) {
  82             ok($status, "parse ($key)");
  83             @fields = $parser->fields;
  84             ok(($count = scalar(@fields)) == 6, "Number of fields ($count of 6)");
  85             my $j = 0;
  86             foreach my $f (@fields) {
  87                 ++$j;
  88                 if ($j==4) {
  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             }
 101         }
 102         else {
 103             ok(! $status, "parse ($key) fails as expected");
 104         }
 105     }
 106 }
 107 done_testing();