From: Tara L Andrews <tla@mit.edu>
Date: Sun, 2 Sep 2012 21:05:42 +0000 (+0200)
Subject: catch dot syntax errors on stemma init
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=64a368343ad4c0b7d9b8e4dc49ca5e0d8029e0c6;p=scpubgit%2Fstemmatology.git

catch dot syntax errors on stemma init
---

diff --git a/lib/Text/Tradition/Stemma.pm b/lib/Text/Tradition/Stemma.pm
index 6e38ac8..e87b9c8 100644
--- a/lib/Text/Tradition/Stemma.pm
+++ b/lib/Text/Tradition/Stemma.pm
@@ -92,6 +92,42 @@ if called directly it takes the following options:
 
 =back
 
+=begin testing
+
+use Text::Tradition::Collation;
+use TryCatch;
+
+use_ok( 'Text::Tradition::Stemma' );
+
+# Placeholder collation to use in tests
+my $c = Text::Tradition::Collation->new();
+
+# Try to create a bad graph
+my $baddotfh;
+open( $baddotfh, 't/data/besoin_bad.dot' ) or die "Could not open test dotfile";
+try {
+	my $stemma = Text::Tradition::Stemma->new( collation => $c, dot => $baddotfh );
+	ok( 0, "Created broken stemma from dotfile with syntax error" );
+} catch( Text::Tradition::Error $e ) {
+	like( $e->message, qr/^Error trying to parse/, "Syntax error in dot threw exception" );
+}
+
+# Create a good graph
+my $dotfh;
+open( $dotfh, 't/data/florilegium.dot' ) or die "Could not open test dotfile";
+binmode( $dotfh, ':utf8' );
+my $stemma = Text::Tradition::Stemma->new( collation => $c, dot => $dotfh );
+is( ref( $stemma ), 'Text::Tradition::Stemma', "Created stemma from good dotfile" );
+is( scalar $stemma->witnesses, 13, "Found correct number of extant witnesses" );
+is( scalar $stemma->hypotheticals, 8, "Found correct number of extant hypotheticals" );
+my $found_unicode_sigil;
+foreach my $h ( $stemma->hypotheticals ) {
+	$found_unicode_sigil = 1 if $h eq "\x{3b1}";
+}
+ok( $found_unicode_sigil, "Found a correctly encoded Unicode sigil" );
+
+=end testing
+
 =cut
 
 has collation => (
@@ -118,16 +154,26 @@ sub BUILD {
 sub _graph_from_dot {
 	my( $self, $dotfh ) = @_;
  	my $reader = Graph::Reader::Dot->new();
+ 	# Redirect STDOUT in order to trap any error messages - syntax errors
+ 	# are evidently not fatal.
+ 	my $reader_out;
+ 	my $saved_stderr;
+ 	open $saved_stderr, ">&STDOUT";
+ 	close STDOUT;
+ 	open STDOUT, ">", \$reader_out;
 	my $graph = $reader->read_graph( $dotfh );
-	if( $graph ) {
-		$self->graph( $graph );
-		# Go through the nodes and set any non-hypothetical node to extant.
-		foreach my $v ( $self->graph->vertices ) {
-			$self->graph->set_vertex_attribute( $v, 'class', 'extant' )
-				unless $self->graph->has_vertex_attribute( $v, 'class' );
-		}
-	} else {
-		throw( "Failed to parse dot in $dotfh" );
+	close STDOUT;
+	open STDOUT, ">", \$saved_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" );
+	}
+	$self->graph( $graph );
+	# Go through the nodes and set any non-hypothetical node to extant.
+	foreach my $v ( $self->graph->vertices ) {
+		$self->graph->set_vertex_attribute( $v, 'class', 'extant' )
+			unless $self->graph->has_vertex_attribute( $v, 'class' );
 	}
 }
 
diff --git a/t/data/besoin_bad.dot b/t/data/besoin_bad.dot
new file mode 100644
index 0000000..77a6b09
--- /dev/null
+++ b/t/data/besoin_bad.dot
@@ -0,0 +1,30 @@
+digraph Stemma {
+    omega [ class=hypothetical ];
+    T1 [ class=extant ];
+    T2 [ class=extant ];
+    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 ];
+    U [ class=extant ];
+    V [ class=extant ];
+    T1 -> T2;
+    T2 -> A;
+    A -> J;
+    A -> C [ class=ext;
+    C -> M;
+    C -> F;
+    C -> S;
+    S -> D;
+    A -> U;
+    U -> F;
+    U -> V;
+    U -> omega;
+    omega -> B;
+    B -> L;
+}
diff --git a/t/text_tradition_stemma.t b/t/text_tradition_stemma.t
new file mode 100644
index 0000000..27d70a0
--- /dev/null
+++ b/t/text_tradition_stemma.t
@@ -0,0 +1,47 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More 'no_plan';
+$| = 1;
+
+
+
+# =begin testing
+{
+use Text::Tradition::Collation;
+use TryCatch;
+
+use_ok( 'Text::Tradition::Stemma' );
+
+# Placeholder collation to use in tests
+my $c = Text::Tradition::Collation->new();
+
+# Try to create a bad graph
+my $baddotfh;
+open( $baddotfh, 't/data/besoin_bad.dot' ) or die "Could not open test dotfile";
+try {
+	my $stemma = Text::Tradition::Stemma->new( collation => $c, dot => $baddotfh );
+	ok( 0, "Created broken stemma from dotfile with syntax error" );
+} catch( Text::Tradition::Error $e ) {
+	like( $e->message, qr/^Error trying to parse/, "Syntax error in dot threw exception" );
+}
+
+# Create a good graph
+my $dotfh;
+open( $dotfh, 't/data/florilegium.dot' ) or die "Could not open test dotfile";
+binmode( $dotfh, ':utf8' );
+my $stemma = Text::Tradition::Stemma->new( collation => $c, dot => $dotfh );
+is( ref( $stemma ), 'Text::Tradition::Stemma', "Created stemma from good dotfile" );
+is( scalar $stemma->witnesses, 13, "Found correct number of extant witnesses" );
+is( scalar $stemma->hypotheticals, 8, "Found correct number of extant hypotheticals" );
+my $found_unicode_sigil;
+foreach my $h ( $stemma->hypotheticals ) {
+	$found_unicode_sigil = 1 if $h eq "\x{3b1}";
+}
+ok( $found_unicode_sigil, "Found a correctly encoded Unicode sigil" );
+}
+
+
+
+
+1;