base/t/text_tradition_parser_self.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 Safe::Isa;
  12 use Test::Warn;
  13 use Text::Tradition;
  14 use TryCatch;
  15 binmode STDOUT, ":utf8";
  16 binmode STDERR, ":utf8";
  17 eval { no warnings; binmode $DB::OUT, ":utf8"; };
  18
  19 my $tradition = 't/data/florilegium_graphml.xml';
  20 my $t = Text::Tradition->new(
  21     'name'  => 'inline',
  22     'input' => 'Self',
  23     'file'  => $tradition,
  24     );
  25
  26 ok( $t->$_isa('Text::Tradition'), "Parsed GraphML version 2" );
  27 if( $t ) {
  28     is( scalar $t->collation->readings, 319, "Collation has all readings" );
  29     is( scalar $t->collation->paths, 376, "Collation has all paths" );
  30     is( scalar $t->witnesses, 13, "Collation has all witnesses" );
  31 }
  32
  33 # TODO add a relationship, add a stemma, write graphml, reparse it, check that
  34 # the new data is there
  35 my $language_enabled = $t->can('language');
  36 if( $language_enabled ) {
  37         $t->language('Greek');
  38 }
  39 my $stemma_enabled = $t->can('add_stemma');
  40 if( $stemma_enabled ) {
  41         $t->add_stemma( 'dotfile' => 't/data/florilegium.dot' );
  42 }
  43 $t->collation->add_relationship( 'w12', 'w13',
  44         { 'type' => 'grammatical', 'scope' => 'global',
  45           'annotation' => 'This is some note' } );
  46 ok( $t->collation->get_relationship( 'w12', 'w13' ), "Relationship set" );
  47 my $graphml_str = $t->collation->as_graphml;
  48
  49 my $newt = Text::Tradition->new( 'input' => 'Self', 'string' => $graphml_str );
  50 ok( $newt->$_isa('Text::Tradition'), "Parsed current GraphML version" );
  51 if( $newt ) {
  52     is( scalar $newt->collation->readings, 319, "Collation has all readings" );
  53     is( scalar $newt->collation->paths, 376, "Collation has all paths" );
  54     is( scalar $newt->witnesses, 13, "Collation has all witnesses" );
  55     is( scalar $newt->collation->relationships, 1, "Collation has added relationship" );
  56     if( $language_enabled ) {
  57             is( $newt->language, 'Greek', "Tradition has correct language setting" );
  58         }
  59     my $rel = $newt->collation->get_relationship( 'w12', 'w13' );
  60     ok( $rel, "Found set relationship" );
  61     is( $rel->annotation, 'This is some note', "Relationship has its properties" );
  62     if( $stemma_enabled ) {
  63             is( scalar $newt->stemmata, 1, "Tradition has its stemma" );
  64         is( $newt->stemma(0)->witnesses, $t->stemma(0)->witnesses, "Stemma has correct length witness list" );
  65     }
  66 }
  67
  68 # Test warning if we can
  69 unless( $stemma_enabled ) {
  70         my $nst;
  71         warnings_exist {
  72                 $nst = Text::Tradition->new( 'input' => 'Self', 'file' => 't/data/lexformat.xml' );
  73         } [qr/DROPPING stemmata/],
  74                 "Got expected stemma drop warning on parse";
  75 }
  76 }
  77
  78
  79
  80
  81 1;