From: Tara L Andrews <tla@mit.edu>
Date: Thu, 23 Feb 2012 03:47:55 +0000 (+0100)
Subject: allow for prefix/suffix readings
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=629e27b0b63f69e99a5f2a82e360a4081f8d971a;p=scpubgit%2Fstemmatology.git

allow for prefix/suffix readings
---

diff --git a/lib/Text/Tradition/Collation.pm b/lib/Text/Tradition/Collation.pm
index 65984d6..9eac271 100644
--- 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
--- 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;