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