more robust boolean value checking in tests

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

diff --git a/lib/Text/Tradition/Parser/TEI.pm b/lib/Text/Tradition/Parser/TEI.pm
index fa29702..3d5fd03 100644 (file)
--- a/lib/Text/Tradition/Parser/TEI.pm
+++ b/lib/Text/Tradition/Parser/TEI.pm
@@ -62,8 +62,8 @@ my $t = Text::Tradition->new(
 
 is( ref( $t ), 'Text::Tradition', "Parsed parallel-segmentation TEI" );
 if( $t ) {
-    is( scalar $t->collation->readings, 319, "Collation has all readings" );
-    is( scalar $t->collation->paths, 374, "Collation has all paths" );
+    is( scalar $t->collation->readings, 311, "Collation has all readings" );
+    is( scalar $t->collation->paths, 361, "Collation has all paths" );
 }
 
 =end testing
@@ -168,17 +168,16 @@ sub parse {
                 my @new = map { _return_rdg( $_ ) } @{$app_ac->{$sig}->{$app}};
                 _replace_sequence( \@uncorrected, $start, $end, @new );
             }
-            my $source = $c->start;
+            my $source = shift @uncorrected; # the start node
+            warn "Something weird!" unless $source eq $c->start;
             foreach my $rdg ( @uncorrected ) {
-                my $has_base = grep { $_ eq $sig } $c->reading_witnesses( $rdg );
-                if( $rdg ne $c->start && !$has_base ) {
-                    print STDERR sprintf( "Adding path %s from %s -> %s\n",
-                        $sig.$c->ac_label, $source->id, $rdg->id );
-                    $c->add_path( $source, $rdg, $sig.$c->ac_label );
-                }
-                $source = $rdg;
+               unless( $c->has_path( $source, $rdg, $sig ) ) {
+                       $c->add_path( $source, $rdg, $sig.$c->ac_label );
+               }
+               $source = $rdg;
             }
-            print STDERR "Adding a.c. version for witness $sig\n";
+            warn "Something else weird!" unless $source eq $c->end;
+            # print STDERR "Adding a.c. version for witness $sig\n";
             $tradition->witness( $sig )->is_layered( 1 );
         }
     }
@@ -189,6 +188,13 @@ sub parse {
     # Now that we have ranks, see if we have distinct nodes with identical
     # text and identical rank that can be merged.
     $tradition->collation->flatten_ranks();
+    
+    # And now that we've done that, calculate the common nodes.
+    $tradition->collation->calculate_common_readings();
+    
+    # Save the text for each witness so that we can ensure consistency
+    # later on
+       $tradition->collation->text_from_paths();       
 }
 
 sub _clean_sequence {
@@ -200,7 +206,7 @@ sub _clean_sequence {
             my $app_id = $1;
             if( exists $app_ac->{$wit} &&
                 exists $app_ac->{$wit}->{$app_id} ) {
-                print STDERR "Retaining empty placeholder for $app_id\n";
+                # print STDERR "Retaining empty placeholder for $app_id\n";
                 push( @clean_sequence, $rdg );
             }
         } else {
@@ -364,7 +370,6 @@ sub _return_rdg {
                 foreach my $sig ( keys %$text ) {
                     next if $active_wits{$sig};
                     my $l = $tradition->collation->add_reading( {
-                       'collation' => $tradition->collation,
                        'id' => $current_app . "_$i",
                        'is_lacuna' => 1 } );
                     $i++;
@@ -380,7 +385,6 @@ sub _return_rdg {
                 foreach my $i ( 0 .. $#cur_wits ) {
                     my $w = $cur_wits[$i];
                     my $l = $tradition->collation->add_reading( {
-                       'collation' => $tradition->collation,
                        'id' => $current_app . "_$i",
                        'is_lacuna' => 1 } );
                     push( @{$text->{$w}}, $l );
@@ -472,8 +476,7 @@ sub _get_sigla {
             }
         }
         my $rdg = $graph->add_reading(
-               { 'collation' => $graph,
-                 'id' => $xml_id,
+               { 'id' => $xml_id,
                  'text' => $word }
                );
         $used_nodeids{$xml_id} = $rdg;