break out punctuation from the rest of the reading text

[scpubgit/stemmatology.git] / lib / Text / Tradition / Parser / Tabular.pm

diff --git a/lib/Text/Tradition/Parser/Tabular.pm b/lib/Text/Tradition/Parser/Tabular.pm
index 4c1e511..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" );
 }
 
@@ -146,30 +146,11 @@ sub parse {
         my $last_rdg = shift @$p;
         my $new_p = [ $last_rdg ];
         foreach my $rdg ( @$p ) {
-               $DB::single = 1 if $rdg->id eq '228,1';
-            if( $rdg->text eq '#LACUNA#' ) {
-                # If we are in a lacuna already, drop this node.
-                # Otherwise make a lacuna node and drop this node.
-                unless( $last_rdg->is_lacuna ) {
-                       my $l_id = 'l' . $rdg->id;
-                       my $l;
-                       if( $c->has_reading( $l_id ) ) {
-                               $l = $c->reading( $l_id );
-                       } else {
-                       $l = $c->add_reading( {
-                                                       'collation' => $c,
-                                                       'id' => $l_id,
-                                                       'is_lacuna' => 1,
-                                                       } );
-                                       }
-                    push( @$new_p, $l );
-                    $last_rdg = $l;
-                }
-                $c->del_reading( $rdg );
-            } else {
-                # No lacuna, save the reading.
-                push( @$new_p, $rdg );
-            }
+               # Omit the reading if we are in a lacuna already.
+               next if $rdg->is_lacuna && $last_rdg->is_lacuna;
+                       # Save the reading otherwise.
+                       push( @$new_p, $rdg );
+                       $last_rdg = $rdg;
         }
         push( @$new_p, $c->end );
         $wit->path( $new_p );
@@ -184,9 +165,13 @@ sub parse {
         $main_wit->uncorrected_path( $ac_wit->path );
         $tradition->del_witness( $ac_wit );
     }
-
+    
     # Join up the paths.
     $c->make_witness_paths;
+    # Delete our unused lacuna nodes.
+       foreach my $rdg ( grep { $_->is_lacuna } $c->readings ) {
+               $c->del_reading( $rdg ) unless $c->reading_witnesses( $rdg );
+       }
 }
 
 sub make_nodes {
@@ -198,11 +183,11 @@ sub make_nodes {
     my $ctr = 1;
     foreach my $w ( keys %unique ) {
        my $rargs = {
-               'collation' => $collation,
                'id' => "$index,$ctr",
                'rank' => $index,
                'text' => $w,
                };
+       $rargs->{'is_lacuna'} = 1 if $w eq '#LACUNA#';
         my $r = $collation->add_reading( $rargs );
         $unique{$w} = $r;
         $ctr++;