From: Tara L Andrews <tla\@mit.edu>
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?p=scpubgit%2Fstemmatology.git;a=commitdiff_plain;h=2a8127263ef278f3f14b480a12b84f9aa4f92fdc

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" );
 }
 }