8 use Text::Tradition::Directory;
11 binmode STDOUT, ':utf8';
12 binmode STDERR, ':utf8';
13 eval { no warnings; binmode $DB::OUT, ':utf8'; $DB::deep = 1000 };
15 my( $dbuser, $dbpass );
16 my $dsn = 'dbi:SQLite:dbname=stemmaweb/db/traditions.db';
21 'u|user=s' => \$dbuser,
22 'p|pass=s' => \$dbpass,
23 'n|test' => \$testrun,
26 my $dbopts = { dsn => $dsn };
27 $dbopts->{extra_args}->{user} = $dbuser if $dbuser;
28 $dbopts->{extra_args}->{password} = $dbpass if $dbpass;
30 my $dir = Text::Tradition::Directory->new( $dbopts );
32 my $scope = $dir->new_scope();
33 my $lookfor = $ARGV[0] || '';
34 foreach my $tinfo ( $dir->traditionlist() ) {
35 next unless $tinfo->{'name'} =~ /$lookfor/ || $tinfo->{'id'} eq $lookfor;
36 my $tradition = $dir->lookup( $tinfo->{id} );
37 say STDERR "Processing tradition " . $tradition->name;
38 my $c = $tradition->collation;
39 $c->flatten_ranks(); # just in case
40 foreach my $rank ( 1 .. $c->end->rank - 1 ) {
41 my @readings = $c->readings_at_rank( $rank );
44 my $r = pop @readings;
46 next if $merged{$r->id};
47 my @orthmatch = grep { lc( $r->text ) eq lc( $_->text ) } @readings;
48 foreach my $om ( @orthmatch ) {
49 if( $r->text eq $om->text ) {
50 say STDERR "Merging identical readings $r and $om ("
53 $c->merge_readings( $r, $om );
55 say STDERR sprintf( "Adding orthographic link for %s and %s (%s / %s)",
56 $r->id, $om->id, $r->text, $om->text );
58 $c->add_relationship( $r, $om,
59 { 'type' => 'orthographic', 'scope' => 'global' } ); };
60 } catch ( Text::Tradition::Error $e ) {
61 say STDERR "Relationship skipped: " . $e->message;
67 $dir->save( $tradition );
70 print STDERR "Done\n";