fix bugs to do with reading relationships

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

diff --git a/lib/Text/Tradition/Collation/Reading.pm b/lib/Text/Tradition/Collation/Reading.pm
index 5c1d866..74e40b5 100644 (file)
--- a/lib/Text/Tradition/Collation/Reading.pm
+++ b/lib/Text/Tradition/Collation/Reading.pm
@@ -17,6 +17,11 @@ has 'rank' => (
     isa => 'Int',
     predicate => 'has_rank',
     );
+    
+has 'is_lacuna' => (
+    is => 'rw',
+    isa => 'Bool',
+    );
 
 # This contains an array of reading objects; the array is a pool,
 # shared by the reading objects inside the pool.  When a reading is
@@ -53,6 +58,14 @@ around position => sub {
     $self->$orig( @args );
 };
 
+# A lacuna node is also a meta node.
+before is_lacuna => sub {
+       my( $self, $arg ) = @_;
+       if( $arg ) {
+               $self->is_meta( 1 );
+       }
+};
+
 # Initialize the identity pool. 
 sub BUILD {
     my( $self, $args ) = @_;
@@ -63,7 +76,11 @@ sub text {
     # Wrapper function around 'label' attribute.
     my $self = shift;
     if( @_ ) {
-       $self->set_attribute( 'label', $_[0] );
+        if( defined $_[0] ) {
+               $self->set_attribute( 'label', $_[0] );
+        } else {
+            $self->del_attribute( 'label' );
+        }
     }
     return $self->label;
 }
@@ -156,6 +173,20 @@ sub is_at_position {
     return $self->position->is_colocated( @_ );
 }
 
+# Looks from the outside like an accessor for a Boolean, but really 
+# sets the node's class.  Should apply to start, end, and lacunae.
+
+sub is_meta {
+       my $self = shift;
+       my $arg = shift;
+       if( defined $arg && $arg ) {
+               $self->set_attribute( 'class', 'meta' );
+       } elsif ( defined $arg ) {
+               $self->del_attribute( 'class' );
+       }
+       return $self->sub_class eq 'meta';      
+}
+
 # Returns all readings that adjoin this one on any path.
 sub neighbor_readings {
     my( $self, $direction ) = @_;
@@ -176,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;
 }
 
@@ -192,6 +234,7 @@ sub is_common {
     return $self->get_attribute( 'class' ) eq 'common';
 }
 
+## TODO Rationalize make_common, is_meta, etc.
 sub make_common {
     my( $self ) = shift;
     $self->set_attribute( 'class', 'common' );