From: Tara L Andrews <tla\@mit.edu>
Date: Sat, 10 Mar 2012 21:37:53 +0000 (+0100)
Subject: Merge branch 'master' of github.com:tla/stemmatology
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=66d659d9da30c55bae6be33887e097b6ce86df8f;hp=f025e3032e82c3134f2fb4f787db40163ac851b4;p=scpubgit%2Fstemmatology.git

Merge branch 'master' of github.com:tla/stemmatology
---

diff --git a/lib/Text/Tradition/Collation/RelationshipStore.pm b/lib/Text/Tradition/Collation/RelationshipStore.pm
index 21faa93..0098563 100644
--- a/lib/Text/Tradition/Collation/RelationshipStore.pm
+++ b/lib/Text/Tradition/Collation/RelationshipStore.pm
@@ -48,12 +48,8 @@ is( scalar @v2, 2, "Added a global relationship with two instances" );
 is( scalar @v1, 1, "Deleted first relationship" );
 @v2 = $c->del_relationship( 'n8', 'n13' );
 is( scalar @v2, 2, "Deleted second global relationship" );
-try {
-	my @v3 = $c->del_relationship( 'n1', 'n2' );
-	ok( 0, "Should have errored on non-existent relationship" );
-} catch( Text::Tradition::Error $e ) {
-	like( $e->message, qr/No relationship defined/, "Attempt to delete non-existent relationship errored" );
-}
+my @v3 = $c->del_relationship( 'n1', 'n2' );
+is( scalar @v3, 0, "Nothing deleted on non-existent relationship" );
 
 =end testing
 
@@ -327,7 +323,7 @@ non-local, removes the relationship everywhere in the graph.
 sub del_relationship {
 	my( $self, $source, $target ) = @_;
 	my $rel = $self->get_relationship( $source, $target );
-	throw( "No relationship defined between $source and $target" ) unless $rel;
+	return () unless $rel; # Nothing to delete; return an empty set.
 	my @vectors = ( [ $source, $target ] );
 	$self->_remove_relationship( $source, $target );
 	if( $rel->nonlocal ) {
diff --git a/script/orth_case_links.pl b/script/orth_case_links.pl
new file mode 100755
index 0000000..06149ca
--- /dev/null
+++ b/script/orth_case_links.pl
@@ -0,0 +1,45 @@
+#!/usr/bin/env perl
+
+use lib 'lib';
+use strict;
+use warnings;
+use Text::Tradition::Directory;
+
+binmode STDERR, ':utf8';
+binmode STDOUT, ':utf8';
+eval { no warnings; binmode $DB::OUT, ':utf8' };
+
+my( $dsn, $user, $pass ) = @ARGV;
+
+my $connect_args = { dsn => $dsn };
+$connect_args->{'extra_args'} = { user => $user, password => $pass }
+	if $user && $pass;
+my $dir = Text::Tradition::Directory->new( $connect_args );
+
+foreach my $text ( $dir->traditionlist ) {
+	my $id = $text->{'id'};
+	my $scope = $dir->new_scope;
+	my $tradition = $dir->lookup( $id );
+	print STDERR "Processing tradition " . $tradition->name . "\n";
+	my $c = $tradition->collation;
+	foreach my $rank ( 1 .. $c->end->rank - 1 ) {
+		my @readings = $c->readings_at_rank( $rank );
+		while( @readings ) {
+			my $r = pop @readings;
+			next if $r->is_meta;
+			my @orthmatch = grep { lc( $r->text ) eq lc( $_->text ) } @readings;
+			foreach my $om ( @orthmatch ) {
+				unless( $c->get_relationship( $r, $om ) ) {
+					print STDERR sprintf( "Adding orthographic link for %s / %s\n", 
+						$r->text, $om->text );
+					$DB::single = 1;
+					$c->add_relationship( $r, $om, 
+						{ 'type' => 'orthographic', 'scope' => 'global' } );
+				}
+			}
+		}		
+	}
+	$dir->save( $tradition );
+}
+
+print STDERR "Done\n";
diff --git a/stemmaweb/lib/stemmaweb/Controller/Relation.pm b/stemmaweb/lib/stemmaweb/Controller/Relation.pm
index 4ca7a25..cd67f6a 100644
--- a/stemmaweb/lib/stemmaweb/Controller/Relation.pm
+++ b/stemmaweb/lib/stemmaweb/Controller/Relation.pm
@@ -110,6 +110,7 @@ sub relationships :Chained('text') :PathPart :Args(0) {
 		my @all_relations;
 		foreach my $p ( @pairs ) {
 			my $relobj = $collation->relations->get_relationship( @$p );
+			next if $relobj->type eq 'collated'; # Don't show these
 			my $relhash = { source => $p->[0], target => $p->[1], 
 				  type => $relobj->type, scope => $relobj->scope };
 			$relhash->{'note'} = $relobj->annotation if $relobj->has_annotation;
diff --git a/t/text_tradition_collation_relationshipstore.t b/t/text_tradition_collation_relationshipstore.t
index 717c878..9f9ed65 100644
--- a/t/text_tradition_collation_relationshipstore.t
+++ b/t/text_tradition_collation_relationshipstore.t
@@ -34,12 +34,8 @@ is( scalar @v2, 2, "Added a global relationship with two instances" );
 is( scalar @v1, 1, "Deleted first relationship" );
 @v2 = $c->del_relationship( 'n8', 'n13' );
 is( scalar @v2, 2, "Deleted second global relationship" );
-try {
-	my @v3 = $c->del_relationship( 'n1', 'n2' );
-	ok( 0, "Should have errored on non-existent relationship" );
-} catch( Text::Tradition::Error $e ) {
-	like( $e->message, qr/No relationship defined/, "Attempt to delete non-existent relationship errored" );
-}
+my @v3 = $c->del_relationship( 'n1', 'n2' );
+is( scalar @v3, 0, "Nothing deleted on non-existent relationship" );
 }