small conveniences
[scpubgit/stemmatology.git] / lib / Text / Tradition / Parser / Tabular.pm
index bf2e077..a561dde 100644 (file)
@@ -115,10 +115,14 @@ foreach my $k ( keys %seen_wits ) {
 sub parse {
     my( $tradition, $opts ) = @_;
     my $c = $tradition->collation; # shorthand
-    my $csv = Text::CSV_XS->new( { 
-        binary => 1, # binary for UTF-8
-        sep_char => exists $opts->{'sep_char'} ? $opts->{'sep_char'} : "\t" } 
-        );
+    my $csv_options = { 'binary' => 1 };
+    $csv_options->{'sep_char'} = $opts->{'sep_char'} || "\t";
+    if( $csv_options->{'sep_char'} eq "\t" ) {
+       # If it is really tab separated, nothing is an escape char.
+       $csv_options->{'quote_char'} = undef;
+       $csv_options->{'escape_char'} = undef;
+    }
+    my $csv = Text::CSV_XS->new( $csv_options );
     
     my $alignment_table;
     if( exists $opts->{'string' } ) {
@@ -173,7 +177,7 @@ sub parse {
     # 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 );
         foreach my $w ( 0 .. $#{$row} ) {
             # push the appropriate node onto the appropriate witness path
             my $word = $row->[$w];
@@ -237,13 +241,18 @@ sub parse {
                                if $wit->has_layertext;
                }
        }
+       
+       # Note that our ranks and common readings are set.
+       $c->_graphcalc_done(1);
 }
 
-sub make_nodes {
+sub _make_nodes {
     my( $collation, $row, $index ) = @_;
     my %unique;
+    my $commonctr = 0; # Holds the number of unique readings + gaps, ex. lacunae.
     foreach my $w ( @$row ) {
         $unique{$w} = 1 if $w;
+        $commonctr +=1 unless ( $w && $w eq '#LACUNA#' );
     }
     my $ctr = 1;
     foreach my $w ( keys %unique ) {
@@ -252,7 +261,11 @@ sub make_nodes {
                'rank' => $index,
                'text' => $w,
                };
-       $rargs->{'is_lacuna'} = 1 if $w eq '#LACUNA#';
+       if( $w eq '#LACUNA#' ) {
+               $rargs->{'is_lacuna'} = 1;
+       } elsif( $commonctr == 1 ) {
+               $rargs->{'is_common'} = 1;
+       }
         my $r = $collation->add_reading( $rargs );
         $unique{$w} = $r;
         $ctr++;