add all graph solver support scripts
Tara L Andrews [Sat, 17 Aug 2013 18:34:32 +0000 (20:34 +0200)]
analysis/idp_server/graphcalc.cgi
analysis/idp_server/graphcalc_worker.pl
analysis/idp_server/idpbackup.pl [new file with mode: 0644]
analysis/idp_server/idprestore.pl [new file with mode: 0644]

index c596641..c537b60 100755 (executable)
@@ -2,7 +2,6 @@
 
 use strict;
 use warnings;
-use lib '/home/tla/stemmatology/lib';
 use CGI;
 use Encode qw/ decode /;
 use Gearman::Client;
@@ -12,10 +11,35 @@ use Text::Tradition::Analysis::Result;
 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
 
@@ -70,9 +94,10 @@ unless( $first eq $request ) {
 # 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
@@ -93,7 +118,7 @@ foreach my $p ( @problems ) {
 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;
index 1cf2549..944ecb3 100755 (executable)
@@ -15,15 +15,47 @@ use IPC::Run qw/ run /;
 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;
 
@@ -77,8 +109,8 @@ sub run_idp {
         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 );
diff --git a/analysis/idp_server/idpbackup.pl b/analysis/idp_server/idpbackup.pl
new file mode 100644 (file)
index 0000000..1dc92c9
--- /dev/null
@@ -0,0 +1,58 @@
+#!/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;
diff --git a/analysis/idp_server/idprestore.pl b/analysis/idp_server/idprestore.pl
new file mode 100644 (file)
index 0000000..358976e
--- /dev/null
@@ -0,0 +1,96 @@
+#!/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