add facilities for removing 'collated' relationship, and for annotation

[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 e9749ad..367cbf8 100644 (file)
--- a/lib/Text/Tradition/Collation/RelationshipStore.pm
+++ b/lib/Text/Tradition/Collation/RelationshipStore.pm
@@ -57,9 +57,24 @@ has 'graph' => (
        relationships => 'edges',
        add_reading => 'add_vertex',
        delete_reading => 'delete_vertex',
+       delete_relationship => 'delete_edge',
     },
        );
        
+around 'delete_relationship' => sub {
+       my $orig = shift;
+       my $self = shift;
+       my @vector;
+       if( @_ == 1 && ref( $_[0] ) eq 'ARRAY' ) {
+               # Dereference the edge arrayref that was passed.
+               my $edge = shift;
+               @vector = @$edge;
+       } else {
+               @vector = @_;
+       }
+       return $self->$orig( @vector );
+};
+       
 =head2 get_relationship
 
 Return the relationship object, if any, that exists between two readings.
@@ -67,7 +82,15 @@ Return the relationship object, if any, that exists between two readings.
 =cut
 
 sub get_relationship {
-       my( $self, @vector ) = @_;
+       my $self = shift;
+       my @vector;
+       if( @_ == 1 && ref( $_[0] ) eq 'ARRAY' ) {
+               # Dereference the edge arrayref that was passed.
+               my $edge = shift;
+               @vector = @$edge;
+       } else {
+               @vector = @_;
+       }
        my $relationship;
        if( $self->graph->has_edge_attribute( @vector, 'object' ) ) {
                $relationship = $self->graph->get_edge_attribute( @vector, 'object' );
@@ -259,7 +282,9 @@ sub relationship_valid {
                # Check that linking the source and target in a relationship won't lead
                # to a path loop for any witness.  If they have the same rank then fine.
                return( 1, "ok" ) 
-                       if $c->reading( $source )->rank == $c->reading( $target )->rank;
+                       if $c->reading( $source )->has_rank
+                               && $c->reading( $target )->has_rank
+                               && $c->reading( $source )->rank == $c->reading( $target )->rank;
                
                # Otherwise, first make a lookup table of all the
                # readings related to either the source or the target.
@@ -365,7 +390,7 @@ sub merge_readings {
        $self->delete_reading( $deleted );
 }
 
-sub as_graphml { 
+sub _as_graphml { 
        my( $self, $graphml_ns, $xmlroot, $node_hash, $nodeid_key, $edge_keys ) = @_;
        
     my $rgraph = $xmlroot->addNewChild( $graphml_ns, 'graph' );