use strict;
use warnings;
-use lib '/home/tla/stemmatology/lib';
use CGI;
use Encode qw/ decode /;
use Gearman::Client;
use TryCatch;
### Configurable variables
-use vars qw/ $DBDSN $DBUSER $DBPASS /;
-$DBDSN = 'dbi:mysql:dbname=stemmaweb';
-$DBUSER = 'FILLMEIN';
-$DBPASS = 'FILLMEIN';
+my %VARS = (
+ DBTYPE => 'mysql',
+ DBHOST => '127.0.0.1',
+ DBPORT => '3006',
+ DBNAME => 'idpresult',
+ DSN => undef,
+ DBUSER => undef,
+ DBPASS => undef,
+ GEARMAN_SERVER => '127.0.0.1:4730',
+);
+
+if( -f "/etc/graphcalc.conf" ) {
+ # Read the variables in from here.
+ open( GCCONF, "/etc/graphcalc.conf" )
+ or die "Could not open configuration file /etc/graphcalc.conf";
+ while(<GCCONF>) {
+ chomp;
+ s/^\s+//;
+ my( $name, $val ) = split( /\s*\=\s*/, $_ );
+ if( exists $VARS{$name} ) {
+ $VARS{$name} = $val;
+ }
+ }
+ close GCCONF;
+}
+unless( $VARS{DSN} ) {
+ $VARS{DSN} = sprintf( "dbi:%s:dbname=%s;host=%s;port=%s",
+ $VARS{DBTYPE}, $VARS{DBNAME}, $VARS{DBHOST}, $VARS{DBPORT} );
+}
### Main program
# calculation of any that need to be calculated, but don't wait more than two
# seconds for a result. Return the DB version of each of the objects.
my $dbargs = {};
-$dbargs->{user} = $DBUSER if $DBUSER;
-$dbargs->{password} = $DBPASS if $DBPASS;
-my $dir = Text::Tradition::Directory->new( 'dsn' => $DBDSN, 'extra_args' => $dbargs );
+$dbargs->{user} = $VARS{DBUSER} if $VARS{DBUSER};
+$dbargs->{password} = $VARS{DBPASS} if $VARS{DBPASS};
+my $dir = Text::Tradition::Directory->new(
+ 'dsn' => $VARS{DSN}, 'extra_args' => $dbargs );
my $scope = $dir->new_scope;
my %results;
my @resultorder; # Keep track of the order in which we should return the results
if( @needcalc ) {
my $arg = join( ',', map { $_->object_key } @needcalc );
my $client = Gearman::Client->new;
- $client->job_servers( '127.0.0.1:4730' );
+ $client->job_servers( $VARS{GEARMAN_SERVER} );
my $task = $client->dispatch_background( run_idp => $arg );
# See if it finishes quickly
my $wait = 3;
use JSON;
use TryCatch;
+my %VARS = (
+ DBTYPE => 'mysql',
+ DBHOST => '127.0.0.1',
+ DBPORT => '3006',
+ DBNAME => 'idpresult',
+ DSN => undef,
+ DBUSER => undef,
+ DBPASS => undef,
+ GEARMAN_SERVER => '127.0.0.1:4730',
+ IDPBINPATH => '/usr/local/idp/bin',
+ IDPSCRIPTPATH => '/usr/local/idp/script'
+);
+
+if( -f "/etc/graphcalc.conf" ) {
+ # Read the variables in from here.
+ open( GCCONF, "/etc/graphcalc.conf" )
+ or die "Could not open configuration file /etc/graphcalc.conf";
+ while(<GCCONF>) {
+ chomp;
+ s/^\s+//;
+ my( $name, $val ) = split( /\s*\=\s*/, $_ );
+ if( exists $VARS{$name} ) {
+ $VARS{$name} = $val;
+ }
+ }
+ close GCCONF;
+}
+unless( $VARS{DSN} ) {
+ $VARS{DSN} = sprintf( "dbi:%s:dbname=%s;host=%s;port=%s",
+ $VARS{DBTYPE}, $VARS{DBNAME}, $VARS{DBHOST}, $VARS{DBPORT} );
+}
+
my $db = Text::Tradition::Directory->new(
- 'dsn' => 'dbi:mysql:dbname=idpresult',
- 'extra_args' => { 'user' => 'stemmaweb', 'password' => 'l@chmann' } );
+ 'dsn' => $VARS{DSN},
+ 'extra_args' => { 'user' => $VARS{DBUSER}, 'password' => $VARS{DBPASS} } );
my @idp_programs = qw/ findGroupings findClasses /;
# there is also findSources but it is redundant for now
my $witness_map = {};
my $worker = Gearman::Worker->new();
-$worker->job_servers('127.0.0.1:4730');
+$worker->job_servers( $VARS{GEARMAN_SERVER} );
$worker->register_function( run_idp => \&run_idp );
$worker->work while 1;
my %idpanswer;
foreach my $program ( @idp_programs ) {
# Got the data, so send it to IDP.
- $ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';
- chdir('/usr/lib/byzantinist/idp');
+ $ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin:'.$VARS{IDPBINPATH};
+ chdir( $VARS{IDPSCRIPTPATH} );
my @cmd = qw! idp -e !;
push( @cmd, "exec($program)", 'main.idp' );
my( $ret, $err );
--- /dev/null
+#!/usr/bin/env perl
+
+use lib 'lib';
+use feature 'say';
+use strict;
+use warnings;
+use JSON;
+use Text::Tradition::Directory;
+
+binmode STDOUT, ':utf8';
+binmode STDERR, ':utf8';
+eval { no warnings; binmode $DB::OUT, ':utf8'; $DB::deep = 1000 };
+
+my %VARS = (
+ DBTYPE => 'mysql',
+ DBHOST => '127.0.0.1',
+ DBPORT => '3006',
+ DBNAME => 'idpresult',
+ DSN => undef,
+ DBUSER => undef,
+ DBPASS => undef,
+ TMPDIR => '/var/tmp'
+);
+
+if( -f "/etc/graphcalc.conf" ) {
+ # Read the variables in from here.
+ open( GCCONF, "/etc/graphcalc.conf" )
+ or die "Could not open configuration file /etc/graphcalc.conf";
+ while(<GCCONF>) {
+ chomp;
+ s/^\s+//;
+ my( $name, $val ) = split( /\s*\=\s*/, $_ );
+ if( exists $VARS{$name} ) {
+ $VARS{$name} = $val;
+ }
+ }
+ close GCCONF;
+}
+unless( $VARS{DSN} ) {
+ $VARS{DSN} = sprintf( "dbi:%s:dbname=%s;host=%s;port=%s",
+ $VARS{DBTYPE}, $VARS{DBNAME}, $VARS{DBHOST}, $VARS{DBPORT} );
+}
+
+my $dirargs = {};
+$dirargs->{user} = $VARS{DBUSER} if $VARS{DBUSER};
+$dirargs->{password} = $VARS{DBPASS} if $VARS{DBPASS};
+my $dir = Text::Tradition::Directory->new(
+ 'dsn' => $VARS{DSN}, 'extra_args' => $dirargs );
+
+my $scope = $dir->new_scope();
+my $dumpfile = $VARS{TMPDIR}.'/idpbackup.json';
+open( IDPBACKUP, ">$dumpfile" )
+ or die "Could not open dump file $dumpfile for writing";
+binmode IDPBACKUP, ':utf8';
+$dir->scan( sub {
+ say IDPBACKUP JSON->new->allow_blessed->convert_blessed->encode( @_ );
+});
+close IDPBACKUP;
--- /dev/null
+#!/usr/bin/env perl
+
+use lib 'lib';
+use feature 'say';
+use strict;
+use warnings;
+use IPC::Run qw/ run /;
+use JSON;
+use Text::Tradition::Analysis::Result;
+use Text::Tradition::Directory;
+use TryCatch;
+
+binmode STDOUT, ':utf8';
+binmode STDERR, ':utf8';
+eval { no warnings; binmode $DB::OUT, ':utf8'; $DB::deep = 1000 };
+
+my %VARS = (
+ DBTYPE => 'mysql',
+ DBHOST => '127.0.0.1',
+ DBPORT => '3006',
+ DBNAME => 'idpresult',
+ DSN => undef,
+ DBUSER => undef,
+ DBPASS => undef,
+ TMPDIR => '/var/tmp'
+);
+
+if( -f "/etc/graphcalc.conf" ) {
+ # Read the variables in from here.
+ open( GCCONF, "/etc/graphcalc.conf" )
+ or die "Could not open configuration file /etc/graphcalc.conf";
+ while(<GCCONF>) {
+ chomp;
+ s/^\s+//;
+ my( $name, $val ) = split( /\s*\=\s*/, $_ );
+ if( exists $VARS{$name} ) {
+ $VARS{$name} = $val;
+ }
+ }
+ close GCCONF;
+}
+unless( $VARS{DSN} ) {
+ $VARS{DSN} = sprintf( "dbi:%s:dbname=%s;host=%s;port=%s",
+ $VARS{DBTYPE}, $VARS{DBNAME}, $VARS{DBHOST}, $VARS{DBPORT} );
+}
+
+say 'Dropping tables in ' . $VARS{DBNAME};
+my @connectargs = ( '-h', $VARS{DBHOST}, '-P', $VARS{DBPORT}, '-u'.$VARS{DBUSER},
+ '-p'.$VARS{DBPASS}, $VARS{DBNAME} );
+my( $ret, $err );
+my @dump = ( 'mysqldump', '--add-drop-table', '--no-data', @connectargs );
+my @grep = ( 'grep', '^DROP' );
+my @sort = ( 'sort', '-r' );
+my @drop = ( 'mysql', @connectargs );
+run( \@dump, '|', \@grep, '|', \@sort, '|', \@drop, '>' ,\$ret, '2>', \$err )
+ or die "Drop command returned $?:\n$err";
+
+my $dirargs = { create => 1 };
+$dirargs->{user} = $VARS{DBUSER} if $VARS{DBUSER};
+$dirargs->{password} = $VARS{DBPASS} if $VARS{DBPASS};
+my $dir = Text::Tradition::Directory->new(
+ 'dsn' => $VARS{DSN}, 'extra_args' => $dirargs );
+
+my $scope = $dir->new_scope();
+my $dumpfile = $VARS{TMPDIR}.'/idpbackup.json';
+open( IDPBACKUP, "$dumpfile" )
+ or die "Could not open dump file $dumpfile for reading";
+binmode IDPBACKUP, ':utf8';
+my $nodel;
+my $ctr = 0;
+while( <IDPBACKUP> ) {
+ chomp;
+ $ctr++;
+ say STDERR "...$ctr results" unless ( $ctr % 500 );
+ my $struct = from_json( $_ );
+ my $result = Text::Tradition::Analysis::Result->new( $struct );
+ if( $result ) {
+ try {
+ $dir->store( $result->object_key => $result );
+ } catch ($err) {
+ $nodel = 1;
+ if( $err =~ /already in use / || $err =~ /Duplicate/) {
+ say STDERR "Duplicate entry " . $result->object_key;
+ } else {
+ say STDERR "Error saving result " . $result->object_key . ": $err";
+ }
+ }
+ } else {
+ warn "Failed to parse result in $_";
+ $nodel = 1;
+ }
+}
+close IDPBACKUP;
+say "Done.";
+
+unlink( $dumpfile ) unless $nodel;
\ No newline at end of file