#!/usr/bin/perl

print '+----------------------------------------+' . "\n";
print '| LLRnet client v0.9b7 with LLR v3.8.2   |' . "\n";
print '| M. Dettweiler and G. Barnes            |' . "\n";
print '| 2010-09-25, version 0.74               |' . "\n";
print '+----------------------------------------+' . "\n\n";

###########################################################
# Perl script based on Karsten Bonath's Batch-Script for
# using LLRnet 0.9b7 with newer LLR-versions, version 0.74.
# Copyright 2010 Max Dettweiler and Gary Barnes.
###########################################################

# Configuration variables, set as desired
$llrPath = './llr';
$llrnetPath = './llrnet';
$beepOnPrime = "false";
$individualPrimeLog = "false";
$iniOptions = "OutputIterations=10000\n";
$errorTimeout = 60;

# If the user specified -c on the command line, then go into cancel mode
if($ARGV[0] eq "-c") { jobCancel(); }

# This addresses a bug that shows up when running under Cygwin's Perl interpreter.
# For more information see the comments on the subroutine.
fixSaveFiles();

# Main program loop - each loop represents one batch of work being processed.
# Keep looping until the user exits.
while(true)
{
  # Check if tosend.txt exists.  If it exists, previous results were
  # not submitted successfully so they must be submitted now.
  if(-e 'tosend.txt') {
    sendResults();
    checkForPrimes();
    fileCleanup();
    unlink('workfile.txt'); }

  # Check if workfile.txt exists and is loaded.
  # If not, get some new work. Either way, run LLR.
  unless(-s 'workfile.txt') { getPairs(); }
  doLLR();
  if(!llrDone()) { print "LLR exited; assuming user stopped with Ctrl-C.\n"; exit; }
  unless(-e 'lresults.txt') { print "Error: could not find lresults.txt.\n"; exit; }

  # Since LLR has finished a batch, prepare
  # the results to be submitted with LLRnet.
  convertResults();
  
  # Submit results, check for primes, and do file cleanup.
  sendResults();
  checkForPrimes();
  fileCleanup();
  unlink('workfile.txt');
}

# End of execution; subroutines defined below.

sub doLLR
{
  unless(-e 'workfile.txt') { print "Error: could not find workfile.txt.\n"; exit; }

  # If llr.ini is not present, this is a new job; insert options into a fresh llr.ini.
  # If llr.ini is present, check to see if LLR's done in case an earlier run didn't
  # finish but had workfile.txt manually deleted.
  unless(-e 'llr.ini' or !llrDone())
  {
    open(INI, ">llr.ini");
    print INI $iniOptions;
    close(INI);
  }
  
  # Run LLR
  system("$llrPath -d workfile.txt");
}

sub llrDone
{
  # Open llr.ini for reading, if it exists. Otherwise, return true.
  if(-e 'llr.ini') { open(INI, "llr.ini"); }
  else { return true; }
  
  # Look through the file until the "WorkDone=x" line is found.
  # Then check to see whether x is 1 or 0 and return true or false respectively.
  while(<INI>)
  {
    $line = $_;
    chomp($line);
    if($line =~ /WorkDone\=1/) { return 1; }
    if($line =~ /WorkDone\=0/) { return 0; }
  }
  
  # If a WorkDone=x line is not found , then llr.ini is malformed.
  print "Error: llr.ini is malformed.\n";
  exit;
}

sub getPairs
{
  # Keep looping until a new batch is received or the user exits.
  while(true)
  {
    # Make up to 5 communication attempts, and return after a success.
    for($numAttempts = 0; $numAttempts < 5; $numAttempts++)
    {
      system($llrnetPath);
      if(-e 'workfile.txt') { return; }
    }
    print "No pairs are available at this time.\n";
    print "Either the server has dried out or there is a problem connecting to the server.\n";
    print "Sleeping $errorTimeout seconds before trying again.\n";
    sleep($errorTimeout);
  }
}

sub jobCancel
{
  # If tosend.txt already exists, either the server went down or
  # the internet connection was lost during the last batch processing.
  if(-e 'tosend.txt') {
    $numResults = 99999;
    print "Sending all completed results.\n";
    print "Cancelling 0 pairs.\n";
    }
  else {
    convertResults();
    print "Sending $numResults completed results.\n";
    }

  # Check to see if there are unprocessed results before
  # returning pairs to the server.  If so, return results
  # and remove the applicable pairs from workfile.txt.
  if($numResults > 0) {
    # Submit results, check for primes, and do file cleanup.
    sendResults();
    checkForPrimes();
    fileCleanup();
  }

  # Rewrite workfile.txt without the first $numResults lines in
  # preparation for returning all subsequent pairs to the server.
  if($numResults != 99999) {
    rename("workfile.txt", "workfile_save.txt");
    open(WKFS, "workfile_save.txt");
    open(WKF, ">workfile.txt");
    # write header
    $line = <WKFS>;
    chomp($line);
    print WKF "$line\n";
    for($lineCnt = 0; $lineCnt < $numResults; $lineCnt++) {
      # skip lines
      $line = <WKFS>;
    }
    $numCancel = 0;
    while(<WKFS>) {
      # write rest of file
      $numCancel++;
      $line = $_; 
      chomp($line);
      print WKF "$line\n";
    }
    # Write an extra null line due to a quirk in the
    # server communication on the final cancelled pair.
    print WKF "\n";
    print "Cancelling $numCancel pairs.\n";
    $numCancel++;
    close(WKFS);
    unlink('workfile_save.txt');
    # Return all remaining pairs to the server.
    for($lineCnt = 0; $lineCnt < $numCancel; $lineCnt++) {
      system($llrnetPath . " -c");
    }
    close(WKF);
  }
  unlink('tosend.txt');
  unlink('workfile.txt');
  unlink<z???????>;
  exit;
}

sub convertResults
{
  # Get NewPGen header from workfile.txt
  open(WORKFILE, "workfile.txt");
  $header = <WORKFILE>;
  chomp($header);
  close(WORKFILE);
  
  # The rest of this is mostly lifted directly from
  # an earlier script named lresults2tosend.pl.
  open(LRS, "lresults.txt");
  open(TOSEND, ">tosend.txt");
  $numResults = 0;

  while(<LRS>) {
    $JustRead = $_;
    chomp($JustRead);
    ($number, $foo) = split(/ is /, $JustRead);
    ($k, $bnc) = split(/\*/, $number);
    ($base, $nc) = split(/\^/, $bnc);
    if($nc =~ "\-") {
      ($n, $c) = split(/\-/, $nc);
    }
    else {
      ($n, $c) = split(/\+/, $nc);
    }
    if($JustRead =~ "64: ") {
      if($JustRead =~ "OLD64") {
        ($foo, $res64time) = split(/RES64: /, $JustRead);
        ($res64, $time) = split(/.  OLD64/, $res64time);
      }
      else {
        ($foo, $res64time) = split(/64: /, $JustRead);
        ($res64, $time) = split(/  Time /, $res64time);
      }
      print TOSEND "$header $k $n -2 $res64\n";
      $numResults++;
    }
    elsif($JustRead =~ "prime!") {
      print TOSEND "$header $k $n 0 0\n";
      $numResults++;
    }
    elsif($JustRead =~ "Frobenius PRP!") {
      print TOSEND "$header $k $n 0 Frobenius_PRP\n";
      $numResults++;
    }
    elsif($JustRead =~ "factor" or $JustRead =~ "trial") {
      print TOSEND "$header $k $n -2 trial_factored\n";
      $numResults++;
    }
  }
  close(LRS);
  close(TOSEND);
}

sub sendResults
{
  # Keep looping until the pairs are sent or the user exits.
  while(true)
  {
    # Make up to 5 communication attempts, and return after a success.
    for($numAttempts = 0; $numAttempts < 5; $numAttempts++)
    {
      system($llrnetPath);
      if (-z 'tosend.txt') { return; }
    }
    print "Results cannot be returned at this time.\n";
    print "There is a problem connecting to the server.\n";
    print "Sleeping $errorTimeout seconds before trying again.\n";
    sleep($errorTimeout);
  }
}

sub checkForPrimes
{
  # Open workfile.res and throw out the first line (the NewPGen header).  It is not needed.
  open(RES, "workfile.res");
  $foo = <RES>;
  
  # Loop through the rest of the file.  For each prime (i.e. anything other than an
  # empty line) that is found, write it to primes.txt.
  while(<RES>)
  {
    $line = $_;
    chomp($line);
    if($line ne "")
    {
      # If individualPrimeLog is set to true, put primes.txt in the working directory.
      # Otherwise, we put it in the parent directory.
      if($individualPrimeLog eq "true") { open(PRIMELOG, ">>primes.txt"); }
      else { open(PRIMELOG, ">>../primes.txt"); }
      print PRIMELOG $line . "\n";
      close(PRIMELOG);
      # If beepOnPrime is set to true, then beep.
      # May not be supported on all configurations.
      if($beepOnPrime eq "true") { print "\a"; }
    }
  }
}

sub fileCleanup
{
  # Add a timestamp to the lresults_hist showing the time in
  # which pairs were submitted and do some file cleanup.
  $timestamp = getTimestamp();
  system("cat lresults.txt >> lresults_hist.txt");
  open(HIST, ">>lresults_hist.txt");
  print HIST "Submitted to server at $timestamp\n";
  close(HIST);
  unlink('llr.ini');
  unlink('lresults.txt');
  unlink('tosend.txt');
  unlink('workfile.res');
}

sub getTimestamp
{
  # Put time data in an array
  # Order: second, minute, hour, day of month, month, year, day of week, day of year, DST active (1/0)
  @timeStuff = localtime(time);
  # Format the numbers in standard human-readable form and pad with zeroes or spaces as necessary
  $timeStuff[0] = sprintf('%02d', $timeStuff[0]);
  $timeStuff[1] = sprintf('%02d', $timeStuff[1]);
  $timeStuff[2] = sprintf('%02d', $timeStuff[2]);
  $timeStuff[3] = sprintf('%02d', $timeStuff[3]);
  $timeStuff[4] += 1;
  $timeStuff[4] = sprintf('%02d', $timeStuff[4]);
  $timeStuff[5] += 1900;
  $timeStuff[5] = sprintf('%4d', $timeStuff[5]);
  return "[$timeStuff[5]\-$timeStuff[4]\-$timeStuff[3] $timeStuff[2]:$timeStuff[1]:$timeStuff[0]\]";
}

# Find any y* save files from LLR that don't have a corresponding z* and rename
# them to z*'s. This addresses a rare, but potentially problematic bug when running
# under Cygwin's Perl interpreter that only allows enough time for LLR to save a y*
# file but apparently not a z* one. LLR will not automatically pick up the y* file
# to resume from upon restart; it must be renamed to z* first.
sub fixSaveFiles
{
  use File::stat;
  @directoryListing = <*>;
  foreach $fileName (@directoryListing)
  {
    if($fileName =~ /y......./)
    {
      $tailEnd = substr($fileName, 1);
      $zFileName = "z" . $tailEnd;
      if(-e $zFileName)
      {
        $yModTime = stat($fileName)->mtime;
        $zModTime = stat($zFileName)->mtime;
        if($yModTime > $zModTime)
        {
          rename($fileName, $zFileName);
        }
      }
      else
      {
        rename($fileName, $zFileName);
      }
    }
  }
}
