analysis/t/text_tradition_analysis.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 use Text::Tradition::Analysis qw/ run_analysis analyze_variant_location /;
  13
  14 my $datafile = 't/data/florilegium_tei_ps.xml';
  15 my $tradition = Text::Tradition->new( 'input' => 'TEI',
  16                                       'name' => 'test0',
  17                                       'file' => $datafile );
  18 $tradition->enable_stemmata;
  19 my $s = $tradition->add_stemma( 'dotfile' => 't/data/florilegium.dot' );
  20 is( ref( $s ), 'Text::Tradition::Stemma', "Added stemma to tradition" );
  21
  22 my %expected_genealogical = (
  23         1 => 0,
  24         2 => 1,
  25         3 =>  0,
  26         5 =>  0,
  27         7 =>  0,
  28         8 =>  0,
  29         10 => 0,
  30         13 => 1,
  31         33 => 0,
  32         34 => 0,
  33         37 => 0,
  34         60 => 0,
  35         81 => 1,
  36         84 => 0,
  37         87 => 0,
  38         101 => 0,
  39         102 => 0,
  40         122 => 1,
  41         157 => 0,
  42         166 => 1,
  43         169 => 1,
  44         200 => 0,
  45         216 => 1,
  46         217 => 1,
  47         219 => 1,
  48         241 => 1,
  49         242 => 1,
  50         243 => 1,
  51 );
  52
  53 my $data = run_analysis( $tradition, calcdsn => 'dbi:SQLite:dbname=t/data/analysis.db' );
  54 my $c = $tradition->collation;
  55 foreach my $row ( @{$data->{'variants'}} ) {
  56         # Account for rows that used to be "not useful"
  57         unless( exists $expected_genealogical{$row->{'id'}} ) {
  58                 $expected_genealogical{$row->{'id'}} = 1;
  59         }
  60         my $gen_bool = $row->{'genealogical'} ? 1 : 0;
  61         is( $gen_bool, $expected_genealogical{$row->{'id'}},
  62                 "Got correct genealogical flag for row " . $row->{'id'} );
  63         # Check that we have the right row with the right groups
  64         my $rank = $row->{'id'};
  65         foreach my $rdghash ( @{$row->{'readings'}} ) {
  66                 # Skip 'readings' that aren't really
  67                 next unless $c->reading( $rdghash->{'readingid'} );
  68                 # Check the rank
  69                 is( $c->reading( $rdghash->{'readingid'} )->rank, $rank,
  70                         "Got correct reading rank" );
  71                 # Check the witnesses
  72                 my @realwits = sort $c->reading_witnesses( $rdghash->{'readingid'} );
  73                 my @sgrp = sort @{$rdghash->{'group'}};
  74                 is_deeply( \@sgrp, \@realwits, "Reading analyzed with correct groups" );
  75         }
  76 }
  77 is( $data->{'variant_count'}, 58, "Got right total variant number" );
  78 # TODO Make something meaningful of conflict count, maybe test other bits
  79 }
  80
  81
  82
  83
  84 1;