# 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 ) ) {
@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 ) {
# Output substitute start/end readings if necessary
if( $startrank ) {
- $dot .= "\t\"#SUBSTART#\" [ label=\"...\",id=\"__SUBSTART__\" ];\n";
+ $dot .= "\t\"__SUBSTART__\" [ label=\"...\",id=\"__START__\" ];\n";
}
if( $endrank ) {
- $dot .= "\t\"#SUBEND#\" [ label=\"...\",id=\"__SUBEND__\" ];\n";
+ $dot .= "\t\"__SUBEND__\" [ label=\"...\",id=\"__END__\" ];\n";
}
if( $STRAIGHTENHACK ) {
## HACK part 1
- my $startlabel = $startrank ? 'SUBSTART' : 'START';
- $dot .= "\tsubgraph { rank=same \"#$startlabel#\" \"#SILENT#\" }\n";
+ my $startlabel = $startrank ? '__SUBSTART__' : '__START__';
+ $dot .= "\tsubgraph { rank=same \"$startlabel\" \"#SILENT#\" }\n";
$dot .= "\t\"#SILENT#\" [ shape=diamond,color=white,penwidth=0,label=\"\" ];"
}
my %used; # Keep track of the readings that actually appear in the graph
my $witstr = $self->_path_display_label ( $self->reading_witnesses( $self->reading( $node ) ) );
my $variables = { %edge_attrs, 'label' => $witstr };
my $varopts = _dot_attr_string( $variables );
- $dot .= "\t\"#SUBSTART#\" -> \"$node\" $varopts;";
+ $dot .= "\t\"__SUBSTART__\" -> \"$node\" $varopts;";
}
foreach my $node ( keys %subend ) {
my $witstr = $self->_path_display_label ( $self->reading_witnesses( $self->reading( $node ) ) );
my $variables = { %edge_attrs, 'label' => $witstr };
my $varopts = _dot_attr_string( $variables );
- $dot .= "\t\"$node\" -> \"#SUBEND#\" $varopts;";
+ $dot .= "\t\"$node\" -> \"__SUBEND__\" $varopts;";
}
# HACK part 2
if( $STRAIGHTENHACK ) {
- my $endlabel = $endrank ? 'SUBEND' : 'END';
- $dot .= "\t\"#$endlabel#\" -> \"#SILENT#\" [ color=white,penwidth=0 ];\n";
+ my $endlabel = $endrank ? '__SUBEND__' : '__END__';
+ $dot .= "\t\"$endlabel\" -> \"#SILENT#\" [ color=white,penwidth=0 ];\n";
}
$dot .= "}\n";
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
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++;
$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 {