4 use Test::More 'no_plan';
15 use Text::Tradition::Directory;
17 binmode STDOUT, ":utf8";
18 binmode STDERR, ":utf8";
19 eval { no warnings; binmode $DB::OUT, ":utf8"; };
21 my $tradition = 't/data/florilegium_graphml.xml';
22 my $t = Text::Tradition->new(
28 ok( $t->$_isa('Text::Tradition'), "Parsed GraphML version 2" );
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" );
35 # TODO add a relationship, add a stemma, write graphml, reparse it, check that
36 # the new data is there
37 $t->language('Greek');
40 $stemma_enabled = $t->enable_stemmata;
42 ok( 1, "Skipping stemma tests without Analysis module" );
44 if( $stemma_enabled ) {
45 $t->add_stemma( 'dotfile' => 't/data/florilegium.dot' );
47 $t->collation->add_relationship( 'w12', 'w13',
48 { 'type' => 'grammatical', 'scope' => 'global',
49 'annotation' => 'This is some note' } );
50 ok( $t->collation->get_relationship( 'w12', 'w13' ), "Relationship set" );
51 my $graphml_str = $t->collation->as_graphml;
53 my $newt = Text::Tradition->new( 'input' => 'Self', 'string' => $graphml_str );
54 ok( $newt->$_isa('Text::Tradition'), "Parsed current GraphML version" );
56 is( scalar $newt->collation->readings, 319, "Collation has all readings" );
57 is( scalar $newt->collation->paths, 376, "Collation has all paths" );
58 is( scalar $newt->witnesses, 13, "Collation has all witnesses" );
59 is( scalar $newt->collation->relationships, 1, "Collation has added relationship" );
60 is( $newt->language, 'Greek', "Tradition has correct language setting" );
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" );
70 # Test user save / restore
71 my $fh = File::Temp->new();
72 my $file = $fh->filename;
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;
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" );
92 # Test warning if we can
93 unless( $stemma_enabled ) {
96 $nst = Text::Tradition->new( 'input' => 'Self', 'file' => 't/data/lexformat.xml' );
97 } [qr/DROPPING stemmata/],
98 "Got expected stemma drop warning on parse";