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 File::Temp;
  12 use Safe::Isa;
  13 use Test::Warn;
  14 use Text::Tradition;
  15 use Text::Tradition::Directory;
  16 use TryCatch;
  17 binmode STDOUT, ":utf8";
  18 binmode STDERR, ":utf8";
  19 eval { no warnings; binmode $DB::OUT, ":utf8"; };
  20
  21 my $tradition = 't/data/florilegium_graphml.xml';
  22 my $t = Text::Tradition->new(
  23     'name'  => 'inline',
  24     'input' => 'Self',
  25     'file'  => $tradition,
  26     );
  27
  28 ok( $t->$_isa('Text::Tradition'), "Parsed GraphML version 2" );
  29 if( $t ) {
  30     is( scalar $t->collation->readings, 319, "Collation has all readings" );
  31     is( scalar $t->collation->paths, 376, "Collation has all paths" );
  32     is( scalar $t->witnesses, 13, "Collation has all witnesses" );
  33 }
  34
  35 # TODO add a relationship, add a stemma, write graphml, reparse it, check that
  36 # the new data is there
  37 my $language_enabled = $t->can('language');
  38 if( $language_enabled ) {
  39         $t->language('Greek');
  40 }
  41 my $stemma_enabled = $t->can('add_stemma');
  42 if( $stemma_enabled ) {
  43         $t->add_stemma( 'dotfile' => 't/data/florilegium.dot' );
  44 }
  45 $t->collation->add_relationship( 'w12', 'w13',
  46         { 'type' => 'grammatical', 'scope' => 'global',
  47           'annotation' => 'This is some note' } );
  48 ok( $t->collation->get_relationship( 'w12', 'w13' ), "Relationship set" );
  49 my $graphml_str = $t->collation->as_graphml;
  50
  51 my $newt = Text::Tradition->new( 'input' => 'Self', 'string' => $graphml_str );
  52 ok( $newt->$_isa('Text::Tradition'), "Parsed current GraphML version" );
  53 if( $newt ) {
  54     is( scalar $newt->collation->readings, 319, "Collation has all readings" );
  55     is( scalar $newt->collation->paths, 376, "Collation has all paths" );
  56     is( scalar $newt->witnesses, 13, "Collation has all witnesses" );
  57     is( scalar $newt->collation->relationships, 1, "Collation has added relationship" );
  58     if( $language_enabled ) {
  59             is( $newt->language, 'Greek', "Tradition has correct language setting" );
  60         }
  61     my $rel = $newt->collation->get_relationship( 'w12', 'w13' );
  62     ok( $rel, "Found set relationship" );
  63     is( $rel->annotation, 'This is some note', "Relationship has its properties" );
  64     if( $stemma_enabled ) {
  65             is( scalar $newt->stemmata, 1, "Tradition has its stemma" );
  66         is( $newt->stemma(0)->witnesses, $t->stemma(0)->witnesses, "Stemma has correct length witness list" );
  67     }
  68 }
  69
  70 # Test user save / restore
  71 my $fh = File::Temp->new();
  72 my $file = $fh->filename;
  73 $fh->close;
  74 my $dsn = "dbi:SQLite:dbname=$file";
  75 my $userstore = Text::Tradition::Directory->new( { dsn => $dsn,
  76         extra_args => { create => 1 } } );
  77 my $scope = $userstore->new_scope();
  78 my $testuser = $userstore->create_user( { url => 'http://example.com' } );
  79 ok( $testuser->$_isa('Text::Tradition::User'), "Created test user via userstore" );
  80 $testuser->add_tradition( $newt );
  81 is( $newt->user->id, $testuser->id, "Assigned tradition to test user" );
  82 $graphml_str = $newt->collation->as_graphml;
  83 my $usert;
  84 warning_is {
  85         $usert = Text::Tradition->new( 'input' => 'Self', 'string' => $graphml_str );
  86 } 'DROPPING user assignment without a specified userstore',
  87         "Got expected user drop warning on parse";
  88 $usert = Text::Tradition->new( 'input' => 'Self', 'string' => $graphml_str,
  89         'userstore' => $userstore );
  90 is( $usert->user->id, $testuser->id, "Parsed tradition with userstore points to correct user" );
  91
  92 # Test warning if we can
  93 unless( $stemma_enabled ) {
  94         my $nst;
  95         warnings_exist {
  96                 $nst = Text::Tradition->new( 'input' => 'Self', 'file' => 't/data/lexformat.xml' );
  97         } [qr/DROPPING stemmata/],
  98                 "Got expected stemma drop warning on parse";
  99 }
 100 }
 101
 102
 103
 104
 105 1;