allow for prefix/suffix readings

diff --git a/lib/Text/Tradition/Collation.pm b/lib/Text/Tradition/Collation.pm
index 65984d6..9eac271 100644 (file)
--- a/lib/Text/Tradition/Collation.pm
+++ b/lib/Text/Tradition/Collation.pm
@@ -582,6 +582,8 @@ sub as_dot {
         next if $reading->id eq $reading->text;
         my $rattrs;
         my $label = $reading->text;
+        $label .= '-' if $reading->join_next;
+        $label = "-$label" if $reading->join_prior;
         $label =~ s/\"/\\\"/g;
                $rattrs->{'label'} = $label;
                $rattrs->{'fillcolor'} = '#b3f36d' if $reading->is_common && $color_common;
@@ -812,6 +814,9 @@ sub as_graphml {
        is_start => 'boolean',
        is_end => 'boolean',
        is_lacuna => 'boolean',
+       is_common => 'boolean',
+       join_prior => 'boolean',
+       join_next => 'boolean',
        );
     foreach my $datum ( keys %node_data ) {
         $node_data_keys{$datum} = 'dn'.$ndi++;
@@ -1193,7 +1198,17 @@ sub path_text {
        $start = $self->start unless $start;
        $end = $self->end unless $end;
        my @path = grep { !$_->is_meta } $self->reading_sequence( $start, $end, $wit );
-       return join( ' ', map { $_->text } @path );
+       my $pathtext = '';
+       my $last;
+       foreach my $r ( @path ) {
+               if( $r->join_prior || !$last || $last->join_next ) {
+                       $pathtext .= $r->text;
+               } else {
+                       $pathtext .= ' ' . $r->text;
+               }
+               $last = $r;
+       }
+       return $pathtext;
 }
 
 =head1 INITIALIZATION METHODS

diff --git a/lib/Text/Tradition/Collation/Reading.pm b/lib/Text/Tradition/Collation/Reading.pm
index 7a99102..907310d 100644 (file)
--- a/lib/Text/Tradition/Collation/Reading.pm
+++ b/lib/Text/Tradition/Collation/Reading.pm
@@ -118,6 +118,20 @@ has 'rank' => (
     predicate => 'has_rank',
     );
 
+## For prefix/suffix readings
+
+has 'join_prior' => (
+       is => 'ro',
+       isa => 'Bool',
+       default => undef,
+       );
+       
+has 'join_next' => (
+       is => 'ro',
+       isa => 'Bool',
+       default => undef,
+       );
+
 
 around BUILDARGS => sub {
        my $orig = shift;