invalidate alignment table cache on relationship add if appropriate

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

diff --git a/base/lib/Text/Tradition/Collation.pm b/base/lib/Text/Tradition/Collation.pm
index 720d7fe..2576646 100644 (file)
--- a/base/lib/Text/Tradition/Collation.pm
+++ b/base/lib/Text/Tradition/Collation.pm
@@ -233,6 +233,15 @@ sub BUILD {
        { 'collation' => $self, 'is_end' => 1, 'init' => 1 } ) );
 }
 
+sub register_relationship_type {
+       my $self = shift;
+       my %args = @_ == 1 ? %{$_[0]} : @_;
+       if( $self->relations->has_type( $args{name} ) ) {
+               throw( 'Relationship type ' . $args{name} . ' already registered' );
+       }
+       $self->relations->add_type( %args );
+}
+
 ### Reading construct/destruct functions
 
 sub add_reading {
@@ -480,7 +489,7 @@ sub del_path {
        if( $self->sequence->has_edge_attribute( $source, $target, $wit ) ) {
                $self->sequence->delete_edge_attribute( $source, $target, $wit );
        }
-       unless( keys %{$self->sequence->get_edge_attributes( $source, $target )} ) {
+       unless( $self->sequence->has_edge_attributes( $source, $target ) ) {
                $self->sequence->delete_edge( $source, $target );
                $self->relations->delete_equivalence_edge( $source, $target );
        }
@@ -526,7 +535,15 @@ sub add_relationship {
        my $self = shift;
     my( $source, $target, $opts ) = $self->_stringify_args( @_ );
     my( @vectors ) = $self->relations->add_relationship( $source, $target, $opts );
-       $self->_graphcalc_done(0);
+    foreach my $v ( @vectors ) {
+       next unless $self->get_relationship( $v )->colocated;
+       if( $self->reading( $v->[0] )->has_rank && $self->reading( $v->[1] )->has_rank
+               && $self->reading( $v->[0] )->rank ne $self->reading( $v->[1] )->rank ) {
+                       $self->_graphcalc_done(0);
+                       $self->_clear_cache;
+                       last;
+       }
+    }
     return @vectors;
 }
 
@@ -1233,7 +1250,7 @@ sub as_csv {
     return join( "\n", @result );
 }
 
-=head2 alignment_table( $use_refs, $include_witnesses )
+=head2 alignment_table
 
 Return a reference to an alignment table, in a slightly enhanced CollateX
 format which looks like this:
@@ -1245,24 +1262,18 @@ format which looks like this:
                            ... ],
             length => TEXTLEN };
 
-If $use_refs is set to 1, the reading object is returned in the table 
-instead of READINGTEXT; if not, the text of the reading is returned.
-
-If $include_witnesses is set to a hashref, only the witnesses whose sigil
-keys have a true hash value will be included.
-
 =cut
 
 sub alignment_table {
     my( $self ) = @_;
-    $self->calculate_ranks() unless $self->_graphcalc_done;
     return $self->cached_table if $self->has_cached_table;
     
     # Make sure we can do this
        throw( "Need a linear graph in order to make an alignment table" )
                unless $self->linear;
-       $self->calculate_ranks unless $self->end->has_rank;
-       
+    $self->calculate_ranks() 
+       unless $self->_graphcalc_done && $self->end->has_rank;
+
     my $table = { 'alignment' => [], 'length' => $self->end->rank - 1 };
     my @all_pos = ( 1 .. $self->end->rank - 1 );
     foreach my $wit ( sort { $a->sigil cmp $b->sigil } $self->tradition->witnesses ) {
@@ -1312,6 +1323,7 @@ sub _make_witness_row {
     return @filled_row;
 }
 
+
 =head1 NAVIGATION METHODS
 
 =head2 reading_sequence( $first, $last, $sigil, $backup )
@@ -1570,8 +1582,10 @@ ok( $c->has_cached_table, "Alignment table was cached" );
 is( $c->alignment_table, $table, "Cached table returned upon second call" );
 $c->calculate_ranks;
 is( $c->alignment_table, $table, "Cached table retained with no rank change" );
-$c->add_relationship( 'n24', 'n23', { 'type' => 'spelling' } );
-isnt( $c->alignment_table, $table, "Alignment table changed after relationship add" );
+$c->add_relationship( 'n13', 'n23', { type => 'repetition' } );
+is( $c->alignment_table, $table, "Alignment table unchanged after non-colo relationship add" );
+$c->add_relationship( 'n24', 'n23', { type => 'spelling' } );
+isnt( $c->alignment_table, $table, "Alignment table changed after colo relationship add" );
 
 =end testing