Commit | Line | Data |
869a1ada |
1 | #!/usr/bin/env perl |
2 | |
3 | use lib 'lib'; |
4 | use feature 'say'; |
5 | use strict; |
6 | use warnings; |
7 | use Getopt::Long; |
869a1ada |
8 | use Text::Tradition::Directory; |
869a1ada |
9 | use TryCatch; |
10 | |
11 | binmode STDOUT, ':utf8'; |
12 | binmode STDERR, ':utf8'; |
13 | eval { no warnings; binmode $DB::OUT, ':utf8'; $DB::deep = 1000 }; |
14 | |
15 | my( $dbuser, $dbpass ); |
16 | my $dsn = 'dbi:SQLite:dbname=stemmaweb/db/traditions.db'; |
17 | my $testrun; |
18 | |
19 | GetOptions( |
20 | 'dsn=s' => \$dsn, |
21 | 'u|user=s' => \$dbuser, |
22 | 'p|pass=s' => \$dbpass, |
23 | 'n|test' => \$testrun, |
24 | ); |
25 | |
26 | my $dbopts = { dsn => $dsn }; |
27 | $dbopts->{extra_args}->{user} = $dbuser if $dbuser; |
28 | $dbopts->{extra_args}->{password} = $dbpass if $dbpass; |
29 | |
30 | my $dir = Text::Tradition::Directory->new( $dbopts ); |
31 | |
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 | my $c = $tradition->collation; |
38 | |
39 | # Anywhere in the graph that there is a reading that joins only to a single |
40 | # successor, and neither of these have any relationships, just join the two |
41 | # readings. |
6771a1b1 |
42 | |
43 | # Save/update the current path texts |
869a1ada |
44 | foreach my $wit ( $tradition->witnesses ) { |
6771a1b1 |
45 | my @pathtext = split( /\s+/, $c->path_text( $wit->sigil ) ); |
46 | $wit->text( \@pathtext ); |
869a1ada |
47 | if( $wit->is_layered ) { |
6771a1b1 |
48 | my @layertext = split( /\s+/, $c->path_text( $wit->sigil.$c->ac_label ) ); |
49 | $wit->layertext( \@layertext ); |
869a1ada |
50 | } |
51 | } |
6771a1b1 |
52 | |
53 | # Do the deed |
54 | $c->compress_readings(); |
55 | # ...and save it. |
869a1ada |
56 | $dir->save( $tradition ); |
57 | } |