X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FText%2FTradition%2FCollation.pm;h=fcdd1ff78959c66662fc5ac00a9481fba6afdf90;hb=2a8127263ef278f3f14b480a12b84f9aa4f92fdc;hp=a77f74f519bd6b7d7e7c2ee78e9a4bd129c5ed10;hpb=7cd9f181280b397e3ef6c95845270d48368fc11f;p=scpubgit%2Fstemmatology.git

diff --git a/lib/Text/Tradition/Collation.pm b/lib/Text/Tradition/Collation.pm
index a77f74f..fcdd1ff 100644
--- a/lib/Text/Tradition/Collation.pm
+++ b/lib/Text/Tradition/Collation.pm
@@ -642,15 +642,15 @@ sub as_dot {
 
 	# Output substitute start/end readings if necessary
 	if( $startrank ) {
-		$dot .= "\t\"#SUBSTART#\" [ label=\"...\" ];\n";
+		$dot .= "\t\"__SUBSTART__\" [ label=\"...\",id=\"__START__\" ];\n";
 	}
 	if( $endrank ) {
-		$dot .= "\t\"#SUBEND#\" [ label=\"...\" ];\n";	
+		$dot .= "\t\"__SUBEND__\" [ label=\"...\",id=\"__END__\" ];\n";	
 	}
 	if( $STRAIGHTENHACK ) {
 		## HACK part 1
-		my $startlabel = $startrank ? 'SUBSTART' : 'START';
-		$dot .= "\tsubgraph { rank=same \"#$startlabel#\" \"#SILENT#\" }\n";  
+		my $startlabel = $startrank ? '__SUBSTART__' : '__START__';
+		$dot .= "\tsubgraph { rank=same \"$startlabel\" \"#SILENT#\" }\n";  
 		$dot .= "\t\"#SILENT#\" [ shape=diamond,color=white,penwidth=0,label=\"\" ];"
 	}
 	my %used;  # Keep track of the readings that actually appear in the graph
@@ -672,6 +672,7 @@ sub as_dot {
         $label = "-$label" if $reading->join_prior;
         $label =~ s/\"/\\\"/g;
 		$rattrs->{'label'} = $label;
+		$rattrs->{'id'} = $reading->id;
 		$rattrs->{'fillcolor'} = '#b3f36d' if $reading->is_common && $color_common;
         $dot .= sprintf( "\t\"%s\" %s;\n", $reading->id, _dot_attr_string( $rattrs ) );
     }
@@ -721,18 +722,18 @@ sub as_dot {
     	my $witstr = $self->_path_display_label ( $self->reading_witnesses( $self->reading( $node ) ) );
     	my $variables = { %edge_attrs, 'label' => $witstr };
         my $varopts = _dot_attr_string( $variables );
-        $dot .= "\t\"#SUBSTART#\" -> \"$node\" $varopts;";
+        $dot .= "\t\"__SUBSTART__\" -> \"$node\" $varopts;";
 	}
     foreach my $node ( keys %subend ) {
     	my $witstr = $self->_path_display_label ( $self->reading_witnesses( $self->reading( $node ) ) );
     	my $variables = { %edge_attrs, 'label' => $witstr };
         my $varopts = _dot_attr_string( $variables );
-        $dot .= "\t\"$node\" -> \"#SUBEND#\" $varopts;";
+        $dot .= "\t\"$node\" -> \"__SUBEND__\" $varopts;";
 	}
 	# HACK part 2
 	if( $STRAIGHTENHACK ) {
-		my $endlabel = $endrank ? 'SUBEND' : 'END';
-		$dot .= "\t\"#$endlabel#\" -> \"#SILENT#\" [ color=white,penwidth=0 ];\n";
+		my $endlabel = $endrank ? '__SUBEND__' : '__END__';
+		$dot .= "\t\"$endlabel\" -> \"#SILENT#\" [ color=white,penwidth=0 ];\n";
 	}       
 
     $dot .= "}\n";
@@ -886,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
@@ -929,6 +937,7 @@ sub as_graphml {
     	'Str' => 'string',
     	'Int' => 'int',
     	'Bool' => 'boolean',
+    	'ReadingID' => 'string',
     	'RelationshipType' => 'string',
     	'RelationshipScope' => 'string',
     );
@@ -955,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++;
@@ -1028,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 {
@@ -1727,12 +1743,12 @@ my $c = $t->collation;
 is( $c->common_predecessor( 'n24', 'n23' )->id, 
     'n20', "Found correct common predecessor" );
 is( $c->common_successor( 'n24', 'n23' )->id, 
-    '#END#', "Found correct common successor" );
+    '__END__', "Found correct common successor" );
 
 is( $c->common_predecessor( 'n19', 'n17' )->id, 
     'n16', "Found correct common predecessor for readings on same path" );
 is( $c->common_successor( 'n21', 'n10' )->id, 
-    '#END#', "Found correct common successor for readings on same path" );
+    '__END__', "Found correct common successor for readings on same path" );
 
 =end testing