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