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 e5921a6..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;
@@ -773,7 +787,8 @@ is( scalar $st->collation->relationships, 3, "Reparsed collation has new relatio
 
 sub as_graphml {
     my( $self ) = @_;
-
+       $self->calculate_ranks unless $self->_graphcalc_done;
+       
     # Some namespaces
     my $graphml_ns = 'http://graphml.graphdrawing.org/xmlns';
     my $xsi_ns = 'http://www.w3.org/2001/XMLSchema-instance';
@@ -810,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++;
@@ -829,6 +847,7 @@ sub as_graphml {
        relationship => 'string',               # ID/label for a relationship
        extra => 'boolean',                             # Path key
        scope => 'string',                              # Relationship key
+       annotation => 'string',                 # Relationship key
        non_correctable => 'boolean',   # Relationship key
        non_independent => 'boolean',   # Relationship key
        );
@@ -1190,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
@@ -1337,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.
@@ -1414,44 +1444,6 @@ sub flatten_ranks {
         }
     }
 }
-
-=head2 remove_collations
-
-Another convenience method for parsing. Removes all 'collation' relationships
-that were defined in order to get the reading ranks to be correct.
-
-=begin testing
-
-use Text::Tradition;
-
-my $cxfile = 't/data/Collatex-16.xml';
-my $t = Text::Tradition->new( 
-    'name'  => 'inline', 
-    'input' => 'CollateX',
-    'file'  => $cxfile,
-    );
-my $c = $t->collation;
-
-isnt( $c->reading('n23')->rank, $c->reading('n9')->rank, "Rank skew exists" );
-$c->add_relationship( 'n23', 'n9', { 'type' => 'collated', 'scope' => 'local' } );
-is( scalar $c->relationships, 4, "Found all expected relationships" );
-$c->remove_collations;
-is( scalar $c->relationships, 3, "Collated relationships now gone" );
-is( $c->reading('n23')->rank, $c->reading('n9')->rank, "Aligned ranks were preserved" );
-
-=end testing
-
-=cut
-
-sub remove_collations {
-       my $self = shift;
-       foreach my $reledge ( $self->relationships ) {
-               my $relobj = $self->relations->get_relationship( $reledge );
-               if( $relobj && $relobj->type eq 'collated' ) {
-                       $self->relations->delete_relationship( $reledge );
-               }
-       }
-}
        
 
 =head2 calculate_common_readings