base/t/text_tradition_parser_tabular.t

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use Test::More 'no_plan';
   5 $| = 1;
   6
   7
   8
   9 # =begin testing
  10 {
  11 use Text::Tradition;
  12 binmode STDOUT, ":utf8";
  13 binmode STDERR, ":utf8";
  14 eval { no warnings; binmode $DB::OUT, ":utf8"; };
  15
  16 my $csv = 't/data/florilegium.csv';
  17 my $t = Text::Tradition->new(
  18     'name'  => 'inline',
  19     'input' => 'Tabular',
  20     'file'  => $csv,
  21     'sep_char' => ',',
  22     );
  23
  24 is( ref( $t ), 'Text::Tradition', "Parsed florilegium CSV file" );
  25
  26 ### TODO Check these figures
  27 if( $t ) {
  28     is( scalar $t->collation->readings, 311, "Collation has all readings" );
  29     is( scalar $t->collation->paths, 361, "Collation has all paths" );
  30     is( scalar $t->witnesses, 13, "Collation has all witnesses" );
  31 }
  32
  33 # Check that we have the right witnesses
  34 my %seen_wits;
  35 map { $seen_wits{$_} = 0 } qw/ A B C D E F G H K P Q S T /;
  36 foreach my $wit ( $t->witnesses ) {
  37         $seen_wits{$wit->sigil} = 1;
  38 }
  39 is( scalar keys %seen_wits, 13, "No extra witnesses were made" );
  40 foreach my $k ( keys %seen_wits ) {
  41         ok( $seen_wits{$k}, "Witness $k still exists" );
  42 }
  43
  44 # Check that the witnesses have the right texts
  45 foreach my $wit ( $t->witnesses ) {
  46         my $origtext = join( ' ', @{$wit->text} );
  47         my $graphtext = $t->collation->path_text( $wit->sigil );
  48         is( $graphtext, $origtext, "Collation matches original for witness " . $wit->sigil );
  49 }
  50
  51 # Check that the a.c. witnesses have the right text
  52 map { $seen_wits{$_} = 0 } qw/ A B C D F G H K S /;
  53 foreach my $k ( keys %seen_wits ) {
  54         my $wit = $t->witness( $k );
  55         if( $seen_wits{$k} ) {
  56                 ok( $wit->is_layered, "Witness $k got marked as layered" );
  57                 ok( $wit->has_layertext, "Witness $k has an a.c. version" );
  58                 my $origtext = join( ' ', @{$wit->layertext} );
  59                 my $acsig = $wit->sigil . $t->collation->ac_label;
  60                 my $graphtext = $t->collation->path_text( $acsig );
  61                 is( $graphtext, $origtext, "Collation matches original a.c. for witness $k" );
  62         } else {
  63                 ok( !$wit->is_layered, "Witness $k not marked as layered" );
  64                 ok( !$wit->has_layertext, "Witness $k has no a.c. version" );
  65         }
  66 }
  67
  68 # Check that we only have collation relationships where we need them
  69 is( scalar $t->collation->relationships, 3, "Redundant collations were removed" );
  70
  71 ## Check excel parsing
  72
  73 my $xls = 't/data/armexample.xls';
  74 my $xt = Text::Tradition->new(
  75         'name'  => 'excel test',
  76         'input' => 'Tabular',
  77         'file'  => $xls,
  78         'excel'   => 'xls'
  79         );
  80
  81 is( ref( $xt ), 'Text::Tradition', "Parsed test Excel 97-2004 file" );
  82 my %xls_wits;
  83 map { $xls_wits{$_} = 0 } qw/ Wit1 Wit2 Wit3 /;
  84 foreach my $wit ( $xt->witnesses ) {
  85         $xls_wits{$wit->sigil} = 1;
  86 }
  87 is( scalar keys %xls_wits, 3, "No extra witnesses were made" );
  88 foreach my $k ( keys %xls_wits ) {
  89         ok( $xls_wits{$k}, "Witness $k still exists" );
  90 }
  91 is( scalar $xt->collation->readings, 11, "Got correct number of test readings" );
  92 is( scalar $xt->collation->paths, 13, "Got correct number of reading paths" );
  93 is( $xt->collation->reading('r5.1')->text, "\x{587}",
  94         "Correct decoding of at least one reading" );
  95
  96 my $xlsx = 't/data/armexample.xlsx';
  97 my $xtx = Text::Tradition->new(
  98         'name'  => 'excel test',
  99         'input' => 'Tabular',
 100         'file'  => $xlsx,
 101         'excel'   => 'xlsx'
 102         );
 103
 104 is( ref( $xtx ), 'Text::Tradition', "Parsed test Excel 2007+ file" );
 105 my %xlsx_wits;
 106 map { $xlsx_wits{$_} = 0 } qw/ Wit1 Wit2 Wit3 /;
 107 foreach my $wit ( $xtx->witnesses ) {
 108         $xlsx_wits{$wit->sigil} = 1;
 109 }
 110 is( scalar keys %xlsx_wits, 3, "No extra witnesses were made" );
 111 foreach my $k ( keys %xlsx_wits ) {
 112         ok( $xlsx_wits{$k}, "Witness $k still exists" );
 113 }
 114 is( scalar $xtx->collation->readings, 12, "Got correct number of test readings" );
 115 is( scalar $xtx->collation->paths, 14, "Got correct number of reading paths" );
 116 is( $xtx->collation->reading('r5.1')->text, "\x{587}",
 117         "Correct decoding of at least one reading" );
 118 }
 119
 120
 121
 122
 123 1;