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 (file)
--- 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 (file)
--- 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();