X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FText%2FTradition%2FCollation%2FRelationshipStore.pm;h=d8b06e2375777b0f8d32c489d42fa131f32ae131;hb=778251a62300cb4b18914b845c418bf27f2df6b8;hp=2f8784c208c176e9db3991f20235ece854395aaf;hpb=1d73ecad0553ddaa59760867355ab975bb3186ed;p=scpubgit%2Fstemmatology.git

diff --git a/lib/Text/Tradition/Collation/RelationshipStore.pm b/lib/Text/Tradition/Collation/RelationshipStore.pm
index 2f8784c..d8b06e2 100644
--- a/lib/Text/Tradition/Collation/RelationshipStore.pm
+++ b/lib/Text/Tradition/Collation/RelationshipStore.pm
@@ -351,8 +351,12 @@ sub relationship_valid {
 		# Otherwise, first make a lookup table of all the
 		# readings related to either the source or the target.
 		my @proposed_related = ( $source, $target );
-		push( @proposed_related, $self->related_readings( $source, 'colocated' ) );
-		push( @proposed_related, $self->related_readings( $target, 'colocated' ) );
+		# Drop the collation links of source and target, unless we want to
+		# add a collation relationship.
+		foreach my $r ( ( $source, $target ) ) {
+			$self->_drop_collations( $r ) unless $rel eq 'collated';
+			push( @proposed_related, $self->related_readings( $r, 'colocated' ) );
+		}
 		my %pr_ids;
 		map { $pr_ids{ $_ } = 1 } @proposed_related;
 	
@@ -376,6 +380,15 @@ sub relationship_valid {
 	}
 }
 
+sub _drop_collations {
+	my( $self, $reading ) = @_;
+	foreach my $n ( $self->graph->neighbors( $reading ) ) {
+		if( $self->get_relationship( $reading, $n )->type eq 'collated' ) {
+			$self->del_relationship( $reading, $n );
+		}
+	}
+}
+
 =head2 related_readings( $reading, $filter )
 
 Returns a list of readings that are connected via relationship links to $reading.