From: Tara L Andrews <tla@mit.edu>
Date: Wed, 7 Mar 2012 12:30:42 +0000 (+0100)
Subject: script to add orthographic links to case variants
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a0a550ef5b404e40676f182bde180943e3e257fb;p=scpubgit%2Fstemmatology.git

script to add orthographic links to case variants
---

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";