use strict;
use warnings;
-use Text::CSV_XS;
+use Text::CSV;
=head1 NAME
}
}
+# Check that we only have collation relationships where we need them
+is( scalar $t->collation->relationships, 3, "Redundant collations were removed" );
+foreach my $rel ( $t->collation->relationships ) {
+ print STDERR $rel->[0] . " -> " . $rel->[1] . "\n";
+}
+
=end testing
=cut
$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' } ) {
# 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
# 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];
if( $word ) {
my $reading = $nodes->{$word};
my $wit = $witnesses[$w];
- $DB::single = 1 unless $wit;
push( @{$wit->path}, $reading );
} # else skip it for empty readings.
}
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();
}
-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 ) {
'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++;
}
+ # Collate this sequence of readings via a single 'collation' relationship.
+ my @rankrdgs = values %unique;
+ my $collation_rel;
+ while( @rankrdgs ) {
+ my $r = shift @rankrdgs;
+ next if $r->is_meta;
+ foreach my $nr ( @rankrdgs ) {
+ 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;
}