X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=script%2Forth_case_links.pl;h=efde97cc91c927222120cbfb9c54e98779182d91;hb=227d4a1124cebc6d3149f886a3b0edc37fe7a3cd;hp=06149cab3721e89792dd55e952a16676017c2e73;hpb=a0a550ef5b404e40676f182bde180943e3e257fb;p=scpubgit%2Fstemmatology.git

diff --git a/script/orth_case_links.pl b/script/orth_case_links.pl
index 06149ca..efde97c 100755
--- a/script/orth_case_links.pl
+++ b/script/orth_case_links.pl
@@ -18,23 +18,32 @@ my $dir = Text::Tradition::Directory->new( $connect_args );
 
 foreach my $text ( $dir->traditionlist ) {
 	my $id = $text->{'id'};
+	next unless $text->{'name'} =~ /Heinrichi/;
 	my $scope = $dir->new_scope;
 	my $tradition = $dir->lookup( $id );
 	print STDERR "Processing tradition " . $tradition->name . "\n";
 	my $c = $tradition->collation;
+	$c->flatten_ranks(); # just in case
 	foreach my $rank ( 1 .. $c->end->rank - 1 ) {
 		my @readings = $c->readings_at_rank( $rank );
+		my %merged;
 		while( @readings ) {
 			my $r = pop @readings;
 			next if $r->is_meta;
+			next if $merged{$r->id};
 			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' } );
+				if( $r->text eq $om->text ) {
+					print STDERR "Merging identical readings $r and $om (" 
+						. $r->text . ")\n";
+					$merged{$om->id} = 1;
+					$c->merge_readings( $r, $om ); 
+				} else {
+					print STDERR sprintf( "Adding orthographic link for %s and %s (%s / %s)\n", 
+						$r->id, $om->id, $r->text, $om->text );
+					eval { $c->add_relationship( $r, $om, 
+						{ 'type' => 'orthographic', 'scope' => 'global' } ); };
+					print STDERR $@ if $@;
 				}
 			}
 		}