fix change detection bug

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

diff --git a/lib/Text/Tradition/Collation.pm b/lib/Text/Tradition/Collation.pm
index 9076fb3..69b1a59 100644 (file)
--- a/lib/Text/Tradition/Collation.pm
+++ b/lib/Text/Tradition/Collation.pm
@@ -28,6 +28,7 @@ has 'relations' => (
        handles => {
                relationships => 'relationships',
                related_readings => 'related_readings',
+               get_relationship => 'get_relationship',
                del_relationship => 'del_relationship',
        },
        writer => '_set_relations',
@@ -436,6 +437,17 @@ sub add_relationship {
     return @vectors;
 }
 
+around qw/ get_relationship del_relationship / => sub {
+       my $orig = shift;
+       my $self = shift;
+       my @args = @_;
+       if( @args == 1 && ref( $args[0] ) eq 'ARRAY' ) {
+               @args = @{$_[0]};
+       }
+       my( $source, $target ) = $self->_stringify_args( @args );
+       $self->$orig( $source, $target );
+};
+
 =head2 reading_witnesses( $reading )
 
 Return a list of sigils corresponding to the witnesses in which the reading appears.
@@ -581,6 +593,8 @@ sub as_dot {
         next if $reading->id eq $reading->text;
         my $rattrs;
         my $label = $reading->text;
+        $label .= '-' if $reading->join_next;
+        $label = "-$label" if $reading->join_prior;
         $label =~ s/\"/\\\"/g;
                $rattrs->{'label'} = $label;
                $rattrs->{'fillcolor'} = '#b3f36d' if $reading->is_common && $color_common;
@@ -811,6 +825,9 @@ sub as_graphml {
        is_start => 'boolean',
        is_end => 'boolean',
        is_lacuna => 'boolean',
+       is_common => 'boolean',
+       join_prior => 'boolean',
+       join_next => 'boolean',
        );
     foreach my $datum ( keys %node_data ) {
         $node_data_keys{$datum} = 'dn'.$ndi++;
@@ -1192,7 +1209,17 @@ sub path_text {
        $start = $self->start unless $start;
        $end = $self->end unless $end;
        my @path = grep { !$_->is_meta } $self->reading_sequence( $start, $end, $wit );
-       return join( ' ', map { $_->text } @path );
+       my $pathtext = '';
+       my $last;
+       foreach my $r ( @path ) {
+               if( $r->join_prior || !$last || $last->join_next ) {
+                       $pathtext .= $r->text;
+               } else {
+                       $pathtext .= ' ' . $r->text;
+               }
+               $last = $r;
+       }
+       return $pathtext;
 }
 
 =head1 INITIALIZATION METHODS
@@ -1339,7 +1366,8 @@ sub calculate_ranks {
     # Do we need to invalidate the cached data?
     if( $self->has_cached_svg || $self->has_cached_table ) {
        foreach my $r ( $self->readings ) {
-               next if $existing_ranks{$r} == $r->rank;
+               next if defined( $existing_ranks{$r} ) 
+                       && $existing_ranks{$r} == $r->rank;
                # Something has changed, so clear the cache
                $self->_clear_cache;
                        # ...and recalculate the common readings.