CollateX format for GraphML output changed; parser update

[scpubgit/stemmatology.git] / lib / Text / Tradition / Collation / RelationshipStore.pm

diff --git a/lib/Text/Tradition/Collation/RelationshipStore.pm b/lib/Text/Tradition/Collation/RelationshipStore.pm
index a0b7ff3..55d6943 100644 (file)
--- a/lib/Text/Tradition/Collation/RelationshipStore.pm
+++ b/lib/Text/Tradition/Collation/RelationshipStore.pm
@@ -41,19 +41,15 @@ my @v1 = $c->add_relationship( 'n21', 'n22', { 'type' => 'meaning' } );
 is( scalar @v1, 1, "Added a single relationship" );
 is( $v1[0]->[0], 'n21', "Got correct node 1" );
 is( $v1[0]->[1], 'n22', "Got correct node 2" );
-my @v2 = $c->add_relationship( 'n9', 'n23', 
+my @v2 = $c->add_relationship( 'n24', 'n23', 
        { 'type' => 'spelling', 'scope' => 'global' } );
 is( scalar @v2, 2, "Added a global relationship with two instances" );
 @v1 = $c->del_relationship( 'n22', 'n21' );
 is( scalar @v1, 1, "Deleted first relationship" );
-@v2 = $c->del_relationship( 'n8', 'n13' );
+@v2 = $c->del_relationship( 'n12', '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
 
@@ -167,13 +163,16 @@ non-locally.  Key on whichever reading occurs first alphabetically.
 
 sub add_scoped_relationship {
        my( $self, $rel ) = @_;
-       my $r = $self->scoped_relationship( $rel->reading_a, $rel->reading_b );
+       my $rdga = $rel->type eq 'orthographic' ? $rel->reading_a : lc( $rel->reading_a );
+       my $rdgb = $rel->type eq 'orthographic' ? $rel->reading_b : lc( $rel->reading_b );      
+       my $r = $self->scoped_relationship( $rdga, $rdgb );
        if( $r ) {
                warn sprintf( "Scoped relationship of type %s already exists between %s and %s",
-                       $r->type, $rel->reading_a, $rel->reading_b );
+                       $r->type, $rdga, $rdgb );
                return;
        }
-       $self->scopedrels->{$rel->reading_a}->{$rel->reading_b} = $rel;
+       my( $first, $second ) = sort ( $rdga, $rdgb );
+       $self->scopedrels->{$first}->{$second} = $rel;
 }
 
 =head2 scoped_relationship( $reading_a, $reading_b )
@@ -231,8 +230,12 @@ sub add_relationship {
                $options->{'orig_b'} = $target;
        if( $options->{'scope'} ne 'local' ) {
                        # Is there a relationship with this a & b already?
-                       my $otherrel = $self->scoped_relationship( $options->{reading_a}, 
-                               $options->{reading_b} );
+                       # Case-insensitive for non-orthographics.
+                       my $rdga = $options->{'type'} eq 'orthographic' 
+                               ? $options->{'reading_a'} : lc( $options->{'reading_a'} );
+                       my $rdgb = $options->{'type'} eq 'orthographic' 
+                               ? $options->{'reading_b'} : lc( $options->{'reading_b'} );
+                       my $otherrel = $self->scoped_relationship( $rdga, $rdgb );
                        if( $otherrel && $otherrel->type eq $options->{type}
                                && $otherrel->scope eq $options->{scope} ) {
                                warn "Applying existing scoped relationship";
@@ -247,7 +250,7 @@ sub add_relationship {
        my @vectors = [ $source, $target ];
     if( $relationship->colocated && $relationship->nonlocal && !$thispaironly ) {
        push( @vectors, $self->_find_applicable( $relationship ) );
-    } 
+    }
         
     # Now set the relationship(s).
     my @pairs_set;
@@ -256,10 +259,11 @@ sub add_relationship {
        if( $rel && $rel ne $relationship ) {
                if( $rel->nonlocal ) {
                        throw( "Found conflicting relationship at @$v" );
-               } else {
+               } elsif( $rel->type ne 'collated' ) {
+                       # Replace a collation relationship; leave any other sort in place.
                        warn "Not overriding local relationship set at @$v";
+                               next;
                }
-               next;
        }
        $self->_set_relationship( $relationship, @$v );
        push( @pairs_set, $v );
@@ -319,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 ) {
@@ -481,12 +485,9 @@ sub merge_readings {
                # If kept changes its text, drop the relationship.
                next if $combined;
                        
-               # If kept / rel already has a relationship, warn and keep the old
+               # If kept / rel already has a relationship, just keep the old
                my $rel = $self->get_relationship( @vector );
-               if( $rel ) {
-                       warn sprintf( "Readings %s and %s have existing relationship; dropping link with %s", @vector, $deleted );
-                       next;
-               }
+               next if $rel;
                
                # Otherwise, adopt the relationship that would be deleted.
                $rel = $self->get_relationship( @$edge );