From: Tara L Andrews <tla@mit.edu>
Date: Thu, 20 Oct 2011 18:35:33 +0000 (+0200)
Subject: fix bugs to do with reading relationships
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=db5d04e021d6b35ed0ae46ee2bc067ad3472f353;p=scpubgit%2Fstemmatology.git

fix bugs to do with reading relationships
---

diff --git a/lib/Text/Tradition/Collation.pm b/lib/Text/Tradition/Collation.pm
index 2879026..1f4e00f 100644
--- a/lib/Text/Tradition/Collation.pm
+++ b/lib/Text/Tradition/Collation.pm
@@ -246,12 +246,12 @@ sub relationship_valid {
     # The lists of 'in' and 'out' should not have any element that appears
     # in 'proposed_related'.
     foreach my $pr ( @proposed_related ) {
-        foreach my $e ( $pr->incoming ) {
+        foreach my $e ( grep { $_->sub_class eq 'path' } $pr->incoming ) {
             if( exists $pr_ids{ $e->from->name } ) {
                 return 0;
             }
         }
-        foreach my $e ( $pr->outgoing ) {
+        foreach my $e ( grep { $_->sub_class eq 'path' } $pr->outgoing ) {
             if( exists $pr_ids{ $e->to->name } ) {
                 return 0;
             }
diff --git a/lib/Text/Tradition/Collation/Reading.pm b/lib/Text/Tradition/Collation/Reading.pm
index 050f67d..74e40b5 100644
--- a/lib/Text/Tradition/Collation/Reading.pm
+++ b/lib/Text/Tradition/Collation/Reading.pm
@@ -207,13 +207,24 @@ sub neighbor_readings {
 
 # Returns all readings related to the one we've got.
 sub related_readings {
-    my( $self, $colocated ) = @_;
+    my( $self, $colocated, $queried ) = @_;
+    $queried = { $self->name => 1 } unless $queried;
     my @related;
+    # Get the nodes directly related to this one
     foreach my $e ( $self->edges ) {
         next unless $e->isa( 'Text::Tradition::Collation::Relationship' );
         next if $colocated && $e->type eq 'repetition';
-        push( @related, $e->from eq $self ? $e->to : $e->from );
+        my $n = $e->from eq $self ? $e->to : $e->from;
+        next if $queried->{$n->name};
+        push( @related, $n );
     }
+    # Now query those nodes for their relations, recursively
+    map { $queried->{$_->name} = 1 } @related;
+    my @also_related;
+    foreach ( @related ) {
+        push( @also_related, $_->related_readings( $colocated, $queried ) );
+    }
+    push( @related, @also_related );
     return @related;
 }
 
diff --git a/make_tradition.pl b/make_tradition.pl
index 28140e8..5f75f33 100755
--- a/make_tradition.pl
+++ b/make_tradition.pl
@@ -12,7 +12,7 @@ binmode STDOUT, ":utf8";
 eval { no warnings; binmode $DB::OUT, ":utf8"; };
 
 my( $informat, $inbase, $outformat, $help, $linear, $name, $HACK ) 
-    = ( '', '', '', '', 0, 0 );
+    = ( '', '', '', '', 1, 'Tradition', 0 );
 
 GetOptions( 'i|in=s'    => \$informat,
             'b|base=s'  => \$inbase,