From: Tara L Andrews Date: Mon, 4 Jun 2012 00:09:10 +0000 (+0200) Subject: save any defined stemmata in GraphML X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2a8127263ef278f3f14b480a12b84f9aa4f92fdc;p=scpubgit%2Fstemmatology.git save any defined stemmata in GraphML --- diff --git a/lib/Text/Tradition/Collation.pm b/lib/Text/Tradition/Collation.pm index 17e4394..fcdd1ff 100644 --- a/lib/Text/Tradition/Collation.pm +++ b/lib/Text/Tradition/Collation.pm @@ -887,6 +887,13 @@ is( scalar $st->collation->readings, $READINGS, "Reparsed collation has all read is( scalar $st->collation->paths, $PATHS, "Reparsed collation has all paths" ); is( scalar $st->collation->relationships, 3, "Reparsed collation has new relationships" ); +# Now add a stemma, write to GraphML, and parse again. +my $stemma = $tradition->add_stemma( 'dotfile' => 't/data/florilegium.dot' ); +is( ref( $stemma ), 'Text::Tradition::Stemma', "Parsed dotfile into stemma" ); +is( $tradition->stemmata, 1, "Tradition now has the stemma" ); +$graphml = $c->as_graphml; +like( $graphml, qr/digraph/, "Digraph declaration exists in GraphML" ); + =end testing =cut @@ -957,6 +964,8 @@ sub as_graphml { next unless $save_types{$attr->type_constraint->name}; $graph_attributes{$attr->name} = $save_types{$attr->type_constraint->name}; } + # Extra custom key for the tradition stemma(ta) + $graph_attributes{'stemmata'} = 'string'; foreach my $datum ( sort keys %graph_attributes ) { $graph_data_keys{$datum} = 'dg'.$gdi++; @@ -1030,11 +1039,16 @@ sub as_graphml { $sgraph->setAttribute( 'parse.nodes', 0 ); # fill in later $sgraph->setAttribute( 'parse.order', 'nodesfirst' ); - # Collation attribute data + # Tradition/collation attribute data foreach my $datum ( keys %graph_attributes ) { my $value; if( $datum eq 'version' ) { - $value = '3.1'; + $value = '3.2'; + } elsif( $datum eq 'stemmata' ) { + my @stemstrs; + map { push( @stemstrs, $_->editable( {linesep => ''} ) ) } + $self->tradition->stemmata; + $value = join( "\n", @stemstrs ); } elsif( $gattr_from{$datum} eq 'Tradition' ) { $value = $self->tradition->$datum; } else { diff --git a/lib/Text/Tradition/Parser/Self.pm b/lib/Text/Tradition/Parser/Self.pm index 5e92b9a..8483891 100644 --- a/lib/Text/Tradition/Parser/Self.pm +++ b/lib/Text/Tradition/Parser/Self.pm @@ -114,9 +114,10 @@ if( $t ) { is( scalar $t->witnesses, 13, "Collation has all witnesses" ); } -# TODO add a relationship, write graphml, reparse it, check that the rel -# is still there +# TODO add a relationship, add a stemma, write graphml, reparse it, check that +# the new data is there $t->language('Greek'); +$t->add_stemma( 'dotfile' => 't/data/florilegium.dot' ); $t->collation->add_relationship( 'w12', 'w13', { 'type' => 'grammatical', 'scope' => 'global', 'annotation' => 'This is some note' } ); @@ -134,6 +135,8 @@ if( $newt ) { my $rel = $newt->collation->get_relationship( 'w12', 'w13' ); ok( $rel, "Found set relationship" ); is( $rel->annotation, 'This is some note', "Relationship has its properties" ); + is( scalar $newt->stemmata, 1, "Tradition has its stemma" ); + is( $newt->stemma(0)->witnesses, $t->stemma(0)->witnesses, "Stemma has correct length witness list" ); } @@ -160,6 +163,10 @@ sub parse { my $val = $graph_data->{'global'}->{$gkey}; if( $gkey eq 'version' ) { $use_version = $val; + } elsif( $gkey eq 'stemmata' ) { # Special case, yuck + foreach my $dotstr ( split( /\n/, $val ) ) { + $tradition->add_stemma( 'dot' => $dotstr ); + } } elsif( $tmeta->has_attribute( $gkey ) ) { $tradition->$gkey( $val ); } else { diff --git a/t/text_tradition_collation.t b/t/text_tradition_collation.t index bd2ebf3..b0070d4 100644 --- a/t/text_tradition_collation.t +++ b/t/text_tradition_collation.t @@ -84,6 +84,13 @@ my $st = Text::Tradition->new( 'input' => 'Self', 'string' => $graphml ); is( scalar $st->collation->readings, $READINGS, "Reparsed collation has all readings" ); is( scalar $st->collation->paths, $PATHS, "Reparsed collation has all paths" ); is( scalar $st->collation->relationships, 3, "Reparsed collation has new relationships" ); + +# Now add a stemma, write to GraphML, and parse again. +my $stemma = $tradition->add_stemma( 'dotfile' => 't/data/florilegium.dot' ); +is( ref( $stemma ), 'Text::Tradition::Stemma', "Parsed dotfile into stemma" ); +is( $tradition->stemmata, 1, "Tradition now has the stemma" ); +$graphml = $c->as_graphml; +like( $graphml, qr/digraph/, "Digraph declaration exists in GraphML" ); } diff --git a/t/text_tradition_parser_self.t b/t/text_tradition_parser_self.t index 612cf1e..0a1ec10 100644 --- a/t/text_tradition_parser_self.t +++ b/t/text_tradition_parser_self.t @@ -27,9 +27,10 @@ if( $t ) { is( scalar $t->witnesses, 13, "Collation has all witnesses" ); } -# TODO add a relationship, write graphml, reparse it, check that the rel -# is still there +# TODO add a relationship, add a stemma, write graphml, reparse it, check that +# the new data is there $t->language('Greek'); +$t->add_stemma( 'dotfile' => 't/data/florilegium.dot' ); $t->collation->add_relationship( 'w12', 'w13', { 'type' => 'grammatical', 'scope' => 'global', 'annotation' => 'This is some note' } ); @@ -47,6 +48,8 @@ if( $newt ) { my $rel = $newt->collation->get_relationship( 'w12', 'w13' ); ok( $rel, "Found set relationship" ); is( $rel->annotation, 'This is some note', "Relationship has its properties" ); + is( scalar $newt->stemmata, 1, "Tradition has its stemma" ); + is( $newt->stemma(0)->witnesses, $t->stemma(0)->witnesses, "Stemma has correct length witness list" ); } }