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 (file)
--- 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 (executable)
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 (file)
--- 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 (file)
--- 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" );
 }