From: tla <tla@mit.edu>
Date: Sun, 27 Oct 2013 21:15:50 +0000 (+0100)
Subject: ensure that undirected graphs stay undirected after parse. Fixes #11
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cb7414170cf67db95d402587a75aaedb208cc6f6;p=scpubgit%2Fstemmatology.git

ensure that undirected graphs stay undirected after parse. Fixes #11
---

diff --git a/analysis/lib/Text/Tradition/Stemma.pm b/analysis/lib/Text/Tradition/Stemma.pm
index 9bd6f01..c4dd09c 100644
--- a/analysis/lib/Text/Tradition/Stemma.pm
+++ b/analysis/lib/Text/Tradition/Stemma.pm
@@ -127,8 +127,15 @@ foreach my $h ( $stemma->hypotheticals ) {
 }
 ok( $found_unicode_sigil, "Found a correctly encoded Unicode sigil" );
 
-# TODO Create stemma from graph, create stemma from undirected graph,
-# create stemma from incompletely-specified graph
+# Create an undirected graph
+my $undirdotfh;
+open( $undirdotfh, 't/data/besoin_undirected.dot' ) or die "Could not open test dotfile";
+binmode( $undirdotfh, ':utf8' );
+my $udstemma = Text::Tradition::Stemma->new( dot => $undirdotfh );
+is( ref( $udstemma ), 'Text::Tradition::Stemma', "Created stemma from undirected dotfile" );
+is( scalar $udstemma->witnesses, 13, "Found correct number of extant witnesses" );
+is( scalar $udstemma->hypotheticals, 12, "Found correct number of hypotheticals" );
+ok( $udstemma->is_undirected, "Stemma was recorded as undirected" );
 
 =end testing
 
@@ -168,7 +175,7 @@ before 'graph' => sub {
 		# Make sure all unclassed graph nodes are marked extant.
 		my $g = $_[0];
 		throw( "Cannot set graph to a non-Graph object" ) 
-			unless ref( $g ) eq 'Graph';
+			unless $g->isa( 'Graph' );
 		foreach my $v ( $g->vertices ) {
 			unless( $g->has_vertex_attribute( $v, 'class' ) ) {
 				$g->set_vertex_attribute( $v, 'class', 'extant' );
@@ -195,17 +202,29 @@ sub _graph_from_dot {
  	# are evidently not fatal.
 	my $graph;
 	my $reader_out;
+	my $reader_err;
 	{
 		local(*STDOUT);
 		open( STDOUT, ">", \$reader_out );
+		local(*STDERR);
+		open( STDERR, ">", \$reader_err );
 		$graph = $reader->read_graph( $dotfh );
 		close STDOUT;
+		close STDERR;
 	}
 	if( $reader_out && $reader_out =~ /error/s ) {
 		throw( "Error trying to parse dot: $reader_out" );
 	} elsif( !$graph ) {
 		throw( "Failed to create graph from dot" );
 	}
+	# Correct for implicit graph -> digraph quirk of reader
+	if( $reader_err && $reader_err =~ /graph will be treated as digraph/ ) {
+		my $udgraph = $graph->undirected_copy;
+		foreach my $v ( $graph->vertices ) {
+			$udgraph->set_vertex_attributes( $v, $graph->get_vertex_attributes( $v ) );
+		}
+		$graph = $udgraph;
+	}
 	$self->graph( $graph );
 }
 
diff --git a/analysis/t/data/besoin_undirected.dot b/analysis/t/data/besoin_undirected.dot
new file mode 100644
index 0000000..75df083
--- /dev/null
+++ b/analysis/t/data/besoin_undirected.dot
@@ -0,0 +1,52 @@
+graph stemma {
+  0 [ class=hypothetical ];
+  1 [ class=hypothetical ];
+  10 [ class=hypothetical ];
+  11 [ class=hypothetical ];
+  2 [ class=hypothetical ];
+  3 [ class=hypothetical ];
+  4 [ class=hypothetical ];
+  5 [ class=hypothetical ];
+  6 [ class=hypothetical ];
+  7 [ class=hypothetical ];
+  8 [ class=hypothetical ];
+  9 [ class=hypothetical ];
+  A [ class=extant ];
+  B [ class=extant ];
+  C [ class=extant ];
+  D [ class=extant ];
+  F [ class=extant ];
+  J [ class=extant ];
+  L [ class=extant ];
+  M [ class=extant ];
+  S [ class=extant ];
+  T1 [ class=extant ];
+  T2 [ class=extant ];
+  U [ class=extant ];
+  V [ class=extant ];
+  0 -- 1;
+  0 -- C;
+  10 -- 11;
+  10 -- 9;
+  10 -- V;
+  11 -- F;
+  11 -- U;
+  1 -- 2;
+  1 -- M;
+  2 -- 3;
+  2 -- D;
+  3 -- 4;
+  4 -- 5;
+  5 -- 6;
+  6 -- 7;
+  7 -- 8;
+  8 -- 9;
+  A -- 6;
+  B -- 4;
+  J -- 5;
+  L -- 3;
+  S -- 9;
+  T1 -- 8;
+  T2 -- 7;
+}
+
diff --git a/analysis/t/text_tradition_stemma.t b/analysis/t/text_tradition_stemma.t
index 44c7698..784f11f 100644
--- a/analysis/t/text_tradition_stemma.t
+++ b/analysis/t/text_tradition_stemma.t
@@ -38,6 +38,16 @@ foreach my $h ( $stemma->hypotheticals ) {
 }
 ok( $found_unicode_sigil, "Found a correctly encoded Unicode sigil" );
 
+# Create an undirected graph
+my $undirdotfh;
+open( $undirdotfh, 't/data/besoin_undirected.dot' ) or die "Could not open test dotfile";
+binmode( $undirdotfh, ':utf8' );
+my $udstemma = Text::Tradition::Stemma->new( dot => $undirdotfh );
+is( ref( $udstemma ), 'Text::Tradition::Stemma', "Created stemma from undirected dotfile" );
+is( scalar $udstemma->witnesses, 13, "Found correct number of extant witnesses" );
+is( scalar $udstemma->hypotheticals, 12, "Found correct number of hypotheticals" );
+ok( $udstemma->is_undirected, "Stemma was recorded as undirected" );
+
 # TODO Create stemma from graph, create stemma from undirected graph,
 # create stemma from incompletely-specified graph
 }