break out punctuation from the rest of the reading text

diff --git a/lib/Text/Tradition/Collation/Reading.pm b/lib/Text/Tradition/Collation/Reading.pm
index 6906da8..7c0daa9 100644 (file)
--- a/lib/Text/Tradition/Collation/Reading.pm
+++ b/lib/Text/Tradition/Collation/Reading.pm
@@ -81,6 +81,22 @@ has 'text' => (
        required => 1,
        writer => 'alter_text',
        );
+       
+has 'punctuation' => (
+       traits => ['Array'],
+       isa => 'ArrayRef[HashRef[Str]]',
+       default => sub { [] },
+       handles => {
+                       punctuation => 'elements',
+                       add_punctuation => 'push',
+                       },
+       );
+
+has 'separate_punctuation' => (
+       is => 'ro',
+       isa => 'Bool',
+       default => 1,
+       );
 
 has 'is_start' => (
        is => 'ro',
@@ -142,6 +158,33 @@ around BUILDARGS => sub {
        $class->$orig( $args );
 };
 
+# Post-process the given text, stripping punctuation if we are asked.
+sub BUILD {
+       my $self = shift;
+       if( $self->separate_punctuation && !$self->is_meta ) {
+               my $pos = 0;
+               my $wspunct = '';  # word sans punctuation
+               foreach my $char ( split( //, $self->text ) ) {
+                       if( $char =~ /^[[:punct:]]$/ ) {
+                               $self->add_punctuation( { 'char' => $char, 'pos' => $pos } );
+                       } else {
+                               $wspunct .= $char;
+                       }
+                       $pos++;
+               }
+               $self->alter_text( $wspunct );
+       }
+}
+
+sub punctuated_form {
+       my $self = shift;
+       my $word = $self->text;
+       foreach my $p ( sort { $a->{pos} <=> $b->{pos} } $self->punctuation ) {
+               substr( $word, $p->{pos}, 0, $p->{char} );
+       }
+       return $word;
+}
+
 =head2 is_meta
 
 A meta attribute (ha ha), which should be true if any of our 'special'

diff --git a/lib/Text/Tradition/Parser/Tabular.pm b/lib/Text/Tradition/Parser/Tabular.pm
index e632737..f81ec36 100644 (file)
--- a/lib/Text/Tradition/Parser/Tabular.pm
+++ b/lib/Text/Tradition/Parser/Tabular.pm
@@ -68,8 +68,8 @@ is( ref( $t ), 'Text::Tradition', "Parsed florilegium CSV file" );
 
 ### TODO Check these figures
 if( $t ) {
-    is( scalar $t->collation->readings, 312, "Collation has all readings" );
-    is( scalar $t->collation->paths, 363, "Collation has all paths" );
+    is( scalar $t->collation->readings, 311, "Collation has all readings" );
+    is( scalar $t->collation->paths, 361, "Collation has all paths" );
     is( scalar $t->witnesses, 13, "Collation has all witnesses" );
 }
 

diff --git a/t/text_tradition_collation.t b/t/text_tradition_collation.t
new file mode 100644 (file)
index 0000000..bb283fa
--- /dev/null
+++ b/t/text_tradition_collation.t
@@ -0,0 +1,35 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More 'no_plan';
+$| = 1;
+
+
+
+# =begin testing
+{
+use Text::Tradition;
+
+my $cxfile = 't/data/Collatex-16.xml';
+my $t = Text::Tradition->new( 
+    'name'  => 'inline', 
+    'input' => 'CollateX',
+    'file'  => $cxfile,
+    );
+my $c = $t->collation;
+
+is( $c->common_predecessor( $c->reading('n9'), $c->reading('n23') )->id, 
+    'n20', "Found correct common predecessor" );
+is( $c->common_successor( $c->reading('n9'), $c->reading('n23') )->id, 
+    '#END#', "Found correct common successor" );
+
+is( $c->common_predecessor( $c->reading('n19'), $c->reading('n17') )->id, 
+    'n16', "Found correct common predecessor for readings on same path" );
+is( $c->common_successor( $c->reading('n21'), $c->reading('n26') )->id, 
+    '#END#', "Found correct common successor for readings on same path" );
+}
+
+
+
+
+1;

diff --git a/t/text_tradition_parser_tabular.t b/t/text_tradition_parser_tabular.t
index d7f450c..5426a76 100644 (file)
--- a/t/text_tradition_parser_tabular.t
+++ b/t/text_tradition_parser_tabular.t
@@ -25,8 +25,8 @@ is( ref( $t ), 'Text::Tradition', "Parsed florilegium CSV file" );
 
 ### TODO Check these figures
 if( $t ) {
-    is( scalar $t->collation->readings, 312, "Collation has all readings" );
-    is( scalar $t->collation->paths, 363, "Collation has all paths" );
+    is( scalar $t->collation->readings, 311, "Collation has all readings" );
+    is( scalar $t->collation->paths, 361, "Collation has all paths" );
     is( scalar $t->witnesses, 13, "Collation has all witnesses" );
 }
 }