6 use Text::Tradition::Directory;
9 binmode STDOUT, ':utf8';
10 binmode STDERR, ':utf8';
11 eval { no warnings; binmode $DB::OUT, ':utf8'; $DB::deep = 1000 };
13 my( $dbuser, $dbpass );
14 my $dsn = 'dbi:SQLite:dbname=stemmaweb/db/traditions.db';
18 'u|user=s' => \$dbuser,
19 'p|pass=s' => \$dbpass,
22 my $dbopts = { dsn => $dsn };
23 $dbopts->{extra_args}->{user} = $dbuser if $dbuser;
24 $dbopts->{extra_args}->{password} = $dbpass if $dbpass;
26 my $dir = Text::Tradition::Directory->new( $dbopts );
28 my $scope = $dir->new_scope();
29 my $lookfor = $ARGV[0] || '';
30 foreach my $tinfo ( $dir->traditionlist() ) {
31 next unless $tinfo->{'name'} =~ /$lookfor/ || $tinfo->{'id'} eq $lookfor;
32 my $tradition = $dir->lookup( $tinfo->{'id'} );
33 # Try to piece together the majority text.
34 my $c = $tradition->collation;
37 while( $curr ne $c->end ) {
39 foreach my $candidate( $c->sequence->successors( $curr ) ) {
40 my $cobj = $c->reading( $candidate );
41 next if $cobj->is_lacuna;
42 my $witnum = scalar keys %{$c->sequence->get_edge_attributes(
43 $curr->id, $candidate )};
44 $witnumbers{$witnum} = $cobj;
46 my @numbers = sort { $a <=> $b } keys %witnumbers;
48 $curr = $witnumbers{ pop @numbers };
49 push( @text, $curr ) unless $curr->is_meta;
51 warn "Did not find non-lacuna successor to $curr";
57 foreach my $r ( @text ) {
58 unless ( $r->join_prior || !$last || $last->join_next ) {
61 $pathtext .= $r->text;