From: tla <tla@mit.edu>
Date: Wed, 18 Apr 2012 10:14:52 +0000 (+0200)
Subject: relationship deletions should include scoped objects
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9d829138736a0629a8604b395995567592c1a989;p=scpubgit%2Fstemmatology.git

relationship deletions should include scoped objects
---

diff --git a/lib/Text/Tradition/Collation/RelationshipStore.pm b/lib/Text/Tradition/Collation/RelationshipStore.pm
index 4bd219c..0dc6a2d 100644
--- a/lib/Text/Tradition/Collation/RelationshipStore.pm
+++ b/lib/Text/Tradition/Collation/RelationshipStore.pm
@@ -272,6 +272,19 @@ sub add_relationship {
     return @pairs_set;
 }
 
+=head2 del_scoped_relationship( $reading_a, $reading_b )
+
+Returns the general (document-level or global) relationship that has been defined 
+between the two reading strings. Returns undef if there is no general relationship.
+
+=cut
+
+sub del_scoped_relationship {
+	my( $self, $rdga, $rdgb ) = @_;
+	my( $first, $second ) = sort( $rdga, $rdgb );
+	return delete $self->scopedrels->{$first}->{$second};
+}
+
 sub _find_applicable {
 	my( $self, $rel ) = @_;
 	my $c = $self->collation;
@@ -328,12 +341,14 @@ sub del_relationship {
 	$self->_remove_relationship( $source, $target );
 	if( $rel->nonlocal ) {
 		# Remove the relationship wherever it occurs.
+		# Remove the relationship wherever it occurs.
 		my @rel_edges = grep { $self->get_relationship( @$_ ) == $rel }
 			$self->relationships;
 		foreach my $re ( @rel_edges ) {
 			$self->_remove_relationship( @$re );
 			push( @vectors, $re );
 		}
+		$self->del_scoped_relationship( $rel->reading_a, $rel->reading_b );
 	}
 	return @vectors;
 }