6 use Text::Tradition::Directory;
8 binmode STDERR, ':utf8';
9 binmode STDOUT, ':utf8';
10 eval { no warnings; binmode $DB::OUT, ':utf8' };
12 my( $dsn, $user, $pass ) = @ARGV;
14 my $connect_args = { dsn => $dsn };
15 $connect_args->{'extra_args'} = { user => $user, password => $pass }
17 my $dir = Text::Tradition::Directory->new( $connect_args );
19 foreach my $text ( $dir->traditionlist ) {
20 my $id = $text->{'id'};
21 next unless $text->{'name'} =~ /Virtutes/;
22 my $scope = $dir->new_scope;
23 my $tradition = $dir->lookup( $id );
24 print STDERR "Processing tradition " . $tradition->name . "\n";
25 my $c = $tradition->collation;
26 $c->flatten_ranks(); # just in case
27 foreach my $rank ( 1 .. $c->end->rank - 1 ) {
28 my @readings = $c->readings_at_rank( $rank );
31 my $r = pop @readings;
33 next if $merged{$r->id};
34 my @orthmatch = grep { lc( $r->text ) eq lc( $_->text ) } @readings;
35 foreach my $om ( @orthmatch ) {
36 if( $r->text eq $om->text ) {
37 print STDERR "Merging identical readings $r and $om ("
40 $c->merge_readings( $r, $om );
41 } elsif ( $c->get_relationship( $r, $om ) ) {
42 print STDERR sprintf( "Adding orthographic link for %s and %s (%s / %s)\n",
43 $r->id, $om->id, $r->text, $om->text );
44 $c->add_relationship( $r, $om,
45 { 'type' => 'orthographic', 'scope' => 'global' } );
50 $dir->save( $tradition );
53 print STDERR "Done\n";