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