Merge branch 'authentication' of github.com:tla/stemmatology
[scpubgit/stemmatology.git] / lib / Text / Tradition / Parser / Tabular.pm
index 723c0aa..a9ce519 100644 (file)
@@ -2,7 +2,7 @@ package Text::Tradition::Parser::Tabular;
 
 use strict;
 use warnings;
-use Text::CSV_XS;
+use Text::CSV;
 
 =head1 NAME
 
@@ -108,6 +108,9 @@ foreach my $k ( keys %seen_wits ) {
        }
 }      
 
+# Check that we only have collation relationships where we need them
+is( scalar $t->collation->relationships, 3, "Redundant collations were removed" );
+
 =end testing
 
 =cut
@@ -122,7 +125,7 @@ sub parse {
        $csv_options->{'quote_char'} = undef;
        $csv_options->{'escape_char'} = undef;
     }
-    my $csv = Text::CSV_XS->new( $csv_options );
+    my $csv = Text::CSV->new( $csv_options );
     
     my $alignment_table;
     if( exists $opts->{'string' } ) {
@@ -151,14 +154,18 @@ sub parse {
     # Set up the witnesses we find in the first line
     my @witnesses;
     my %ac_wits;  # Track layered witness -> main witness mapping
+    my $aclabel = $c->ac_label;
     foreach my $sigil ( @{$alignment_table->[0]} ) {
-        my $wit = $tradition->add_witness( 'sigil' => $sigil );
-        $wit->path( [ $c->start ] );
-        push( @witnesses, $wit );
-        my $aclabel = $c->ac_label;
         if( $sigil =~ /^(.*)\Q$aclabel\E$/ ) {
+               # Sanitize the sigil name to an XML name
+               $sigil = $1 . '_layered';
             $ac_wits{$sigil} = $1;
         }
+        my $wit = $tradition->add_witness( 
+               'sigil' => $sigil, 'sourcetype' => 'collation' );
+        $wit->path( [ $c->start ] );
+        push( @witnesses, $wit );
+        my $aclabel = $c->ac_label;
     }
     
     # Save the original witness text sequences. Have to loop back through
@@ -173,11 +180,14 @@ sub parse {
        $is_layer ? $wit->layertext( \@words ) : $wit->text( \@words );
     }    
     
+    my $nocollate = ( scalar( @witnesses ) * scalar @$alignment_table ) > 150000;
+    print STDERR "Tradition too big for row collation\n" if $nocollate;
+    
     # Now for the next rows, make nodes as necessary, assign their ranks, and 
     # add them to the witness paths.
     foreach my $idx ( 1 .. $#{$alignment_table} ) {
         my $row = $alignment_table->[$idx];
-        my $nodes = _make_nodes( $c, $row, $idx );
+        my $nodes = _make_nodes( $c, $row, $idx, $nocollate );
         foreach my $w ( 0 .. $#{$row} ) {
             # push the appropriate node onto the appropriate witness path
             my $word = $row->[$w];
@@ -241,10 +251,15 @@ sub parse {
                                if $wit->has_layertext;
                }
        }
+       
+       # Note that our ranks and common readings are set.
+       $c->_graphcalc_done(1);
+       # Remove redundant collation relationships.
+       $c->relations->filter_collations() unless $nocollate;
 }
 
 sub _make_nodes {
-    my( $collation, $row, $index ) = @_;
+    my( $collation, $row, $index, $nocollate ) = @_;
     my %unique;
     my $commonctr = 0; # Holds the number of unique readings + gaps, ex. lacunae.
     foreach my $w ( @$row ) {
@@ -254,7 +269,7 @@ sub _make_nodes {
     my $ctr = 1;
     foreach my $w ( keys %unique ) {
        my $rargs = {
-               'id' => "$index,$ctr",
+               'id' => "r$index.$ctr",
                'rank' => $index,
                'text' => $w,
                };
@@ -267,6 +282,26 @@ sub _make_nodes {
         $unique{$w} = $r;
         $ctr++;
     }
+    # Collate this sequence of readings via a single 'collation' relationship.
+    unless( $nocollate ) {
+               my @rankrdgs = values %unique;
+               my $collation_rel;
+               while( @rankrdgs ) {
+                       my $r = shift @rankrdgs;
+                       next if $r->is_meta;
+                       foreach my $nr ( @rankrdgs ) {
+                               next if $nr->is_meta;
+                               if( $collation_rel ) {
+                                       $collation->add_relationship( $r, $nr, $collation_rel );
+                               } else {
+                                       $collation->add_relationship( $r, $nr, 
+                                               { 'type' => 'collated', 
+                                                 'annotation' => "Parsed together for rank $index" } );
+                                       $collation_rel = $collation->get_relationship( $r, $nr );
+                               }
+                       }
+               }
+       }    
     return \%unique;
 }