get JSON witness parsing to work

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

diff --git a/lib/Text/Tradition/Collation.pm b/lib/Text/Tradition/Collation.pm
index 68b2adf..721b385 100644 (file)
--- a/lib/Text/Tradition/Collation.pm
+++ b/lib/Text/Tradition/Collation.pm
@@ -783,15 +783,34 @@ sub path_witnesses {
        return @wits;
 }
 
+# Helper function. Make a display label for the given witnesses, showing a.c.
+# witnesses only where the main witness is not also in the list.
 sub _path_display_label {
        my $self = shift;
-       my @wits = sort @_;
+       my %wits;
+       map { $wits{$_} = 1 } @_;
+
+       # If an a.c. wit is listed, remove it if the main wit is also listed.
+       # Otherwise keep it for explicit listing.
+       my $aclabel = $self->ac_label;
+       my @disp_ac;
+       foreach my $w ( sort keys %wits ) {
+               if( $w =~ /^(.*)\Q$aclabel\E$/ ) {
+                       if( exists $wits{$1} ) {
+                               delete $wits{$w};
+                       } else {
+                               push( @disp_ac, $w );
+                       }
+               }
+       }
+       
+       # See if we are in a majority situation.
        my $maj = scalar( $self->tradition->witnesses ) * 0.6;
-       if( scalar @wits > $maj ) {
-               # TODO break out a.c. wits
-               return 'majority';
+       if( scalar keys %wits > $maj ) {
+               unshift( @disp_ac, 'majority' );
+               return join( ', ', @disp_ac );
        } else {
-               return join( ', ', @wits );
+               return join( ', ', sort keys %wits );
        }
 }
 
@@ -1306,7 +1325,7 @@ sub common_readings {
        return @common;
 }
 
-=head2 path_text( $sigil, $mainsigil [, $start, $end ] )
+=head2 path_text( $sigil, [, $start, $end ] )
 
 Returns the text of a witness (plus its backup, if we are using a layer)
 as stored in the collation.  The text is returned as a string, where the
@@ -1368,11 +1387,16 @@ sub make_witness_path {
     my( $self, $wit ) = @_;
     my @chain = @{$wit->path};
     my $sig = $wit->sigil;
+    # Add start and end if necessary
+    unshift( @chain, $self->start ) unless $chain[0] eq $self->start;
+    push( @chain, $self->end ) unless $chain[-1] eq $self->end;
     foreach my $idx ( 0 .. $#chain-1 ) {
         $self->add_path( $chain[$idx], $chain[$idx+1], $sig );
     }
     if( $wit->is_layered ) {
         @chain = @{$wit->uncorrected_path};
+               unshift( @chain, $self->start ) unless $chain[0] eq $self->start;
+               push( @chain, $self->end ) unless $chain[-1] eq $self->end;
         foreach my $idx( 0 .. $#chain-1 ) {
             my $source = $chain[$idx];
             my $target = $chain[$idx+1];