From: tla <tla@mit.edu>
Date: Mon, 28 Oct 2013 20:25:21 +0000 (+0100)
Subject: notice and save changes to graph name / stemma identifier (tla/stemmaweb#28)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=907f66717a74634a07dd37f24fccdb5959230b27;p=scpubgit%2Fstemmatology.git

notice and save changes to graph name / stemma identifier (tla/stemmaweb#28)
---

diff --git a/analysis/lib/Text/Tradition/Stemma.pm b/analysis/lib/Text/Tradition/Stemma.pm
index c4dd09c..7ea5e4e 100644
--- a/analysis/lib/Text/Tradition/Stemma.pm
+++ b/analysis/lib/Text/Tradition/Stemma.pm
@@ -187,11 +187,12 @@ before 'graph' => sub {
 after 'graph' => sub {
 	my $self = shift;
 	return unless @_;
-	unless( $self->has_identifier ) {
-		## HORRIBLE HACK but there is no API access to graph attributes!
-		if( exists $_[0]->[4]->{'name'} ) {
-			$self->set_identifier( $_[0]->[4]->{'name'} );
-		}
+	## HORRIBLE HACK but there is no API access to graph attributes!
+	my $graph_id = exists $_[0]->[4]->{'name'} ? $_[0]->[4]->{'name'} : '';
+	if( $graph_id && !( $self->has_identifier && $self->identifier eq $graph_id ) ) {
+		$self->set_identifier( $graph_id );
+	} elsif ( !$graph_id && $self->has_identifier ) {
+		$self->set_identifier( 'stemma' );
 	}
 };
 
@@ -533,6 +534,7 @@ If it is directed, re-root it.
 sub root_graph {
 	my( $self, $rootvertex ) = @_;
 	my $graph;
+	my $ident = $self->identifier; # will have to restore this at the end
 	if( $self->is_undirected ) {
 		$graph = $self->graph;
 	} else {
@@ -568,6 +570,7 @@ sub root_graph {
 	map { $rooted->set_vertex_attribute( $_, 'class', 'extant' ) }
 		$self->witnesses;
 	$self->graph( $rooted );
+	$self->set_identifier( $ident );
 }
 
 
diff --git a/analysis/t/stemma.t b/analysis/t/stemma.t
index 731045d..a4c7ea7 100644
--- a/analysis/t/stemma.t
+++ b/analysis/t/stemma.t
@@ -64,13 +64,18 @@ SKIP: {
 
 # Test our dot output
 my $display = $stemma->as_dot();
-ok( $display =~ /digraph/, "Got a dot display graph" );
+like( $display, qr/^digraph \"?Stemma/, "Got a dot display graph" );
 ok( $display !~ /hypothetical/, "Graph is display rather than edit" );
 # Test our editable output
 my $editable = $stemma->editable();
-ok( $editable =~ /digraph/, "Got a dot edit graph" );
+like( $editable, qr/^digraph \"?Stemma/, "Got a dot edit graph" );
 ok( $editable =~ /hypothetical/, "Graph contains an edit class" );
 
+# Test changing the name of the Graph
+$editable =~ s/^(digraph )\"?Stemma\"?/$1"Simple test stemma"/;
+$stemma->alter_graph( $editable );
+is( $stemma->identifier, "Simple test stemma", "Successfully changed name of graph" );
+
 # Test re-rooting of our graph
 try {
 	$stemma->root_graph('D');
@@ -82,5 +87,8 @@ try {
 $stemma->root_graph( 'B' );
 is( $stemma->graph, '1-A,2-1,2-C,B-2', 
 	"Stemma graph successfully re-rooted on vertex B" );
+is( $stemma->identifier, "Simple test stemma", 
+	"Stemma identifier survived re-rooting of graph" );
+
 
 done_testing();