From: Tara L Andrews Date: Wed, 11 Jul 2012 23:21:31 +0000 (+0200) Subject: regularize some script libs and interface X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=446a738965dd6a13ec11ea519067095d618f82d5;p=scpubgit%2Fstemmatology.git regularize some script libs and interface --- diff --git a/script/join_readings.pl b/script/join_readings.pl index 0b803a8..a5ef593 100755 --- a/script/join_readings.pl +++ b/script/join_readings.pl @@ -5,9 +5,7 @@ use feature 'say'; use strict; use warnings; use Getopt::Long; -use Lingua::Features::Structure; use Text::Tradition::Directory; -use XML::Easy::Syntax qw/ $xml10_name_rx $xml10_namestartchar_rx /; use TryCatch; binmode STDOUT, ':utf8'; diff --git a/script/orth_case_links.pl b/script/orth_case_links.pl index efde97c..9487984 100755 --- a/script/orth_case_links.pl +++ b/script/orth_case_links.pl @@ -1,27 +1,40 @@ #!/usr/bin/env perl use lib 'lib'; +use feature 'say'; use strict; use warnings; +use Getopt::Long; use Text::Tradition::Directory; +use TryCatch; -binmode STDERR, ':utf8'; binmode STDOUT, ':utf8'; -eval { no warnings; binmode $DB::OUT, ':utf8' }; +binmode STDERR, ':utf8'; +eval { no warnings; binmode $DB::OUT, ':utf8'; $DB::deep = 1000 }; + +my( $dbuser, $dbpass ); +my $dsn = 'dbi:SQLite:dbname=stemmaweb/db/traditions.db'; +my $testrun; + +GetOptions( + 'dsn=s' => \$dsn, + 'u|user=s' => \$dbuser, + 'p|pass=s' => \$dbpass, + 'n|test' => \$testrun, + ); -my( $dsn, $user, $pass ) = @ARGV; +my $dbopts = { dsn => $dsn }; +$dbopts->{extra_args}->{user} = $dbuser if $dbuser; +$dbopts->{extra_args}->{password} = $dbpass if $dbpass; -my $connect_args = { dsn => $dsn }; -$connect_args->{'extra_args'} = { user => $user, password => $pass } - if $user && $pass; -my $dir = Text::Tradition::Directory->new( $connect_args ); +my $dir = Text::Tradition::Directory->new( $dbopts ); -foreach my $text ( $dir->traditionlist ) { - my $id = $text->{'id'}; - next unless $text->{'name'} =~ /Heinrichi/; - my $scope = $dir->new_scope; - my $tradition = $dir->lookup( $id ); - print STDERR "Processing tradition " . $tradition->name . "\n"; +my $scope = $dir->new_scope(); +my $lookfor = $ARGV[0] || ''; +foreach my $tinfo ( $dir->traditionlist() ) { + next unless $tinfo->{'name'} =~ /$lookfor/ || $tinfo->{'id'} eq $lookfor; + my $tradition = $dir->lookup( $tinfo->{id} ); + say STDERR "Processing tradition " . $tradition->name; my $c = $tradition->collation; $c->flatten_ranks(); # just in case foreach my $rank ( 1 .. $c->end->rank - 1 ) { @@ -34,16 +47,19 @@ foreach my $text ( $dir->traditionlist ) { my @orthmatch = grep { lc( $r->text ) eq lc( $_->text ) } @readings; foreach my $om ( @orthmatch ) { if( $r->text eq $om->text ) { - print STDERR "Merging identical readings $r and $om (" - . $r->text . ")\n"; + say STDERR "Merging identical readings $r and $om (" + . $r->text . ")"; $merged{$om->id} = 1; $c->merge_readings( $r, $om ); } else { - print STDERR sprintf( "Adding orthographic link for %s and %s (%s / %s)\n", + say STDERR sprintf( "Adding orthographic link for %s and %s (%s / %s)", $r->id, $om->id, $r->text, $om->text ); - eval { $c->add_relationship( $r, $om, - { 'type' => 'orthographic', 'scope' => 'global' } ); }; - print STDERR $@ if $@; + try { + $c->add_relationship( $r, $om, + { 'type' => 'orthographic', 'scope' => 'global' } ); }; + } catch ( Text::Tradition::Error $e ) { + say STDERR "Relationship skipped: " . $e->message; + } } } } diff --git a/script/propagate_transitive.pl b/script/propagate_transitive.pl index afe11d7..2d49467 100755 --- a/script/propagate_transitive.pl +++ b/script/propagate_transitive.pl @@ -5,9 +5,7 @@ use feature 'say'; use strict; use warnings; use Getopt::Long; -use Lingua::Features::Structure; use Text::Tradition::Directory; -use XML::Easy::Syntax qw/ $xml10_name_rx $xml10_namestartchar_rx /; use TryCatch; binmode STDOUT, ':utf8';