save any defined stemmata in GraphML

diff --git a/lib/Text/Tradition/Collation.pm b/lib/Text/Tradition/Collation.pm
index 17e4394..fcdd1ff 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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" );
 }
 }