Merge branch 'master' of github.com:tla/stemmatology

[scpubgit/stemmatology.git] / lib / Text / Tradition / Collation.pm

diff --git a/lib/Text/Tradition/Collation.pm b/lib/Text/Tradition/Collation.pm
index 17e4394..ef0594d 100644 (file)
--- a/lib/Text/Tradition/Collation.pm
+++ b/lib/Text/Tradition/Collation.pm
@@ -373,7 +373,7 @@ sub merge_readings {
        # objects themselves.
     my( $kept, $deleted, $combine, $combine_char ) = $self->_stringify_args( @_ );
        $self->_graphcalc_done(0);
-
+       
     # The kept reading should inherit the paths and the relationships
     # of the deleted reading.
        foreach my $path ( $self->sequence->edges_at( $deleted ) ) {
@@ -387,7 +387,7 @@ sub merge_readings {
                @wits{keys %$fwits} = values %$fwits;
                $self->sequence->set_edge_attributes( @vector, \%wits );
        }
-       $self->relations->merge_readings( $kept, $deleted, $combine_char );
+       $self->relations->merge_readings( $kept, $deleted, $combine );
        
        # Do the deletion deed.
        if( $combine ) {
@@ -560,7 +560,8 @@ sub as_svg {
     throw( "Need GraphViz installed to output SVG" )
        unless File::Which::which( 'dot' );
     my $want_subgraph = exists $opts->{'from'} || exists $opts->{'to'};
-    $self->calculate_ranks() unless( $self->_graphcalc_done || $opts->{'nocalc'} );
+    $self->calculate_ranks() 
+       unless( $self->_graphcalc_done || $opts->{'nocalc'} || !$self->linear );
     if( !$self->has_cached_svg || $opts->{'recalc'}    || $want_subgraph ) {        
                my @cmd = qw/dot -Tsvg/;
                my( $svg, $err );
@@ -817,6 +818,7 @@ sub _path_display_label {
        
        # See if we are in a majority situation.
        my $maj = scalar( $self->tradition->witnesses ) * 0.6;
+       $maj = $maj > 5 ? $maj : 5;
        if( scalar keys %wits > $maj ) {
                unshift( @disp_ac, 'majority' );
                return join( ', ', @disp_ac );
@@ -887,6 +889,13 @@ is( scalar $st->collation->readings, $READINGS, "Reparsed collation has all read
 is( scalar $st->collation->paths, $PATHS, "Reparsed collation has all paths" );
 is( scalar $st->collation->relationships, 3, "Reparsed collation has new relationships" );
 
+# Now add a stemma, write to GraphML, and parse again.
+my $stemma = $tradition->add_stemma( 'dotfile' => 't/data/florilegium.dot' );
+is( ref( $stemma ), 'Text::Tradition::Stemma', "Parsed dotfile into stemma" );
+is( $tradition->stemmata, 1, "Tradition now has the stemma" );
+$graphml = $c->as_graphml;
+like( $graphml, qr/digraph/, "Digraph declaration exists in GraphML" );
+
 =end testing
 
 =cut
@@ -957,6 +966,8 @@ sub as_graphml {
                next unless $save_types{$attr->type_constraint->name};
                $graph_attributes{$attr->name} = $save_types{$attr->type_constraint->name};
        }
+    # Extra custom key for the tradition stemma(ta)
+    $graph_attributes{'stemmata'} = 'string';
        
     foreach my $datum ( sort keys %graph_attributes ) {
        $graph_data_keys{$datum} = 'dg'.$gdi++;
@@ -1030,11 +1041,16 @@ sub as_graphml {
     $sgraph->setAttribute( 'parse.nodes', 0 ); # fill in later
     $sgraph->setAttribute( 'parse.order', 'nodesfirst' );
            
-    # Collation attribute data
+    # Tradition/collation attribute data
     foreach my $datum ( keys %graph_attributes ) {
        my $value;
        if( $datum eq 'version' ) {
-               $value = '3.1';
+               $value = '3.2';
+       } elsif( $datum eq 'stemmata' ) {
+               my @stemstrs;
+               map { push( @stemstrs, $_->editable( {linesep => ''} ) ) } 
+                       $self->tradition->stemmata;
+               $value = join( "\n", @stemstrs );
        } elsif( $gattr_from{$datum} eq 'Tradition' ) {
                $value = $self->tradition->$datum;
        } else {