Index: gs2-extensions/parallel-building/trunk/src/opt/Perseus/perseus-medusa.pl
===================================================================
--- gs2-extensions/parallel-building/trunk/src/opt/Perseus/perseus-medusa.pl	(revision 29649)
+++ gs2-extensions/parallel-building/trunk/src/opt/Perseus/perseus-medusa.pl	(revision 29649)
@@ -0,0 +1,416 @@
+#!/usr/bin/perl
+
+# Pragma
+use strict;
+use warnings;
+$|++; # Unbuffer STDOUT
+
+# Perl Built-in Modules
+use Getopt::Long;
+use IO::Socket::INET;
+use Pod::Usage;
+
+my $start_time = time();
+print "[" . localtime($start_time) . "]\n";
+print "===== Persus =====\n";
+print "To slay a Medusa you need an appropriately shiney shield - this is\n";
+print "that shield.\n";
+print "\n";
+
+# 1. Configuration
+my $debug = 0;
+my $help = 0;
+my $kill_delay = 5;
+my $listen_time = 60;
+my $man = 0;
+my $search_path = '/tmp/perseus.txt';
+my $search_port = 0;
+my $search_url = 'http://www.cms.waikato.ac.nz/~jmt12/perseus.txt';
+GetOptions ('debug'         => \$debug,
+            'kill_delay=i'  => \$kill_delay,
+            'listen_port=i' => \$search_port,
+            'listen_time=i' => \$listen_time,
+            'path=s'        => \$search_path,
+            'url=s'         => \$search_url,
+            'help|?'        => \$help,
+            man             => \$man
+           )
+or pod2usage(2);
+if ($help)
+{
+  pod2usage(1);
+}
+if ($man)
+{
+ pod2usage(-exitval => 0, -verbose => 2);
+}
+print " * Configuration\n";
+print "   - Debug? " . ($debug ? "Yes" : "No") . "\n";
+print "   - Search path: " . $search_path . "\n";
+print "   - Search URL: " . $search_url . "\n";
+print "   - Search port: " . $search_port . "\n";
+print "   - Listen time: " . $listen_time . " seconds\n";
+print "   - Delay before KILL: " . $kill_delay . " seconds\n";
+
+# 2. Search
+print " * Looking for Instructions\n";
+my $instructions = [];
+print "   - Search for sentinel file... ";
+if (&searchPath())
+{
+  print "Found\n";
+}
+else
+{
+  print "Not found\n";
+}
+
+if (scalar(@{$instructions}) == 0)
+{
+    print "   - Search for internet page... ";
+    if (&searchURL())
+    {
+	print "Found\n";
+    }
+    else
+    {
+	print "Not found\n";
+    }
+    print "Done!\n";
+}
+
+if (scalar(@{$instructions}) == 0)
+{
+    if ($search_port > 0)
+    {
+	print "   - Listen on port... ";
+	if (&searchPort())
+	{
+	    print "Contacted\n";
+	}
+	else
+	{
+	    print "No contact\n";
+	}
+	print "Done!\n";
+    }
+    else
+    {
+	print "  - Skipping port search\n";
+    }
+}
+
+
+# 3. Action
+if (scalar(@{$instructions}))
+{
+  print " * Processing Instructions\n";
+  my @instructions2;
+  # - terms and kills first
+  my $instruction_ptr = pop(@{$instructions});
+  while (defined $instruction_ptr)
+  {
+    my @instruction = @{$instruction_ptr};
+    if ($instruction[0] eq 'pid')
+    {
+      &commandTerminate($instruction[1]);
+    }
+    else
+    {
+      push(@instructions2, $instruction_ptr);
+    }
+    $instruction_ptr = pop(@{$instructions});
+  }
+  # - then slays
+  $instruction_ptr = pop(@instructions2);
+  while (defined $instruction_ptr)
+  {
+    my @instruction = @{$instruction_ptr};
+    if ($instruction[0] eq 'user')
+    {
+      &commandSlay($instruction[1]);
+    }
+    else
+    {
+      push(@{$instructions}, $instruction_ptr);
+    }
+    $instruction_ptr = pop(@instructions2);
+  }
+  # - then commands (reboot)
+  $instruction_ptr = pop(@{$instructions});
+  while (defined $instruction_ptr)
+  {
+    my @instruction = @{$instruction_ptr};
+    if ($instruction[0] eq 'cmd' && $instruction[1] eq 'reboot')
+    {
+      &commandReboot();
+    }
+    else
+    {
+      push(@instructions2, $instruction_ptr);
+    }
+    $instruction_ptr = pop(@{$instructions});
+  }
+  # - left overs
+  foreach $instruction_ptr (@instructions2)
+  {
+    my @instruction = @{$instruction_ptr};
+    print "Error! Unrecognized instruction \"" . $instruction[0] . ":" . $instruction[1] . "\"\n";
+  }
+}
+else
+{
+  print " * No Instructions!\n";
+}
+
+# 4. Complete!
+my $end_time = time();
+my $duration = $end_time - $start_time;
+print "===== Complete in " . $duration . " seconds =====\n";
+print "[" . localtime($end_time) . "]\n\n";
+exit;
+
+
+## @function commandIsRunning
+#
+sub commandIsRunning
+{
+  my ($pid) = @_;
+  my $cmd = 'ps -p ' . $pid . ' > /dev/null';
+  `$cmd`;
+  my $retval = $?;
+  return ($retval == 0);
+}
+## commandIsRunning() ##
+
+## @function commandReboot
+#
+# Wait five minutes then reboot the machine
+#
+sub commandReboot
+{
+  print " - rebooting\n";
+  print &shellCommand('shutdown -r +5', 1);
+}
+## commandReboot ##
+
+## @function commandSlay
+#
+sub commandSlay
+{
+  my ($user) = @_;
+  print " - slay all processes by: " . $user . "\n";
+  print &shellCommand('slay -clean ' . $user);
+}
+## commandSlay() ##
+
+## @function commandTerminate
+#
+sub commandTerminate
+{
+  my ($pid) = @_;
+  if (&commandIsRunning($pid))
+  {
+    print " - terminate process: " . $pid . "... ";
+    # send SIGTERM
+    print &shellCommand('kill -s SIGTERM ' . $pid);
+    # wait delay seconds
+    sleep($kill_delay);
+    # see if process still there
+    if (&commandIsRunning($pid))
+    {
+      print "Failed\n";
+      print " - kill process: " . $pid . "... ";
+      print &shellCommand('kill -s SIGKILL ' . $pid);
+      sleep($kill_delay);
+      if (&commandIsRunning($pid))
+      {
+        print "Failed\n";
+      }
+      else
+      {
+        print "Killed\n";
+      }
+    }
+    else
+    {
+      print "Terminated\n";
+    }
+  }
+  else
+  {
+    print "  - can't terminate, no such process: " . $pid . "\n";
+  }
+  # if it is still running then it must be uninterruptable... nothing we can
+  # do from here
+}
+## commandTerminate() ##
+
+
+## @function parseInstructions
+#
+sub parseInstructions
+{
+  my ($content) = @_;
+  my $instruction_count = 0;
+  while ($content =~ s/(pid|user|cmd)\:([^\s]+)//i)
+  {
+    my $type = lc($1);
+    my $value = $2;
+    push(@{$instructions}, [$1, $2]);
+    $instruction_count++;
+  }
+  return $instruction_count;
+}
+## parseInstructions() ##
+
+
+## @function printDebug()
+#
+sub printDebug
+{
+  my ($msg) = @_;
+  if ($debug)
+  {
+    print "[DEBUG] " . $msg . " [" . time() . "]\n";
+  }
+}
+## printDebug() ##
+
+
+## @function searchPath()
+#
+sub searchPath
+{
+  my $result = 0;
+  # A user can ask us to do stuff by dumping a file here
+  if (-e $search_path)
+  {
+    # read instructions (<type>:<value>\n) from the file
+    if (open(FIN, '<:utf8', $search_path))
+    {
+      my $content;
+      sysread(FIN, $content, -s $search_path);
+      $result = &parseInstructions($content);
+      close(FIN);
+    }
+    else
+    {
+      print STDERR "Error! Failed to open file for reading: " . $search_path . "\n";
+    }
+    # remove the file (if we can)
+    #unlink($search_path);
+  }
+  return $result;
+}
+## searchPath() ##
+
+
+## @function searchPort
+#
+sub searchPort
+{
+  my $result = 0;
+  # timeout isn't implemented in Perl sockets, so we cheat and use an alarm
+  # that interrupts an eval block
+  eval {
+    local $SIG{ALRM} = sub { die 'timeout' };
+    alarm $listen_time;
+    my $socket = IO::Socket::INET->new(Proto     => 'tcp',
+                                       LocalPort => $search_port,
+                                       Listen    => 1,
+                                       ReuseAddr => 1
+                                      );
+    if (defined $socket)
+    {
+      print "[listening on port " . $search_port . "... ";
+      while (my $client = $socket->accept())
+      {
+        print "connected... ";
+        $client->autoflush(1);
+        my $line;
+        while ($line = <$client>)
+        {
+          $result += &parseInstruction($line);
+        }
+        close $client;
+        print "complete]";
+      }
+    }
+    else
+    {
+      print STDERR "Error! Failed to open socket for listening: " . $search_port . "\n";
+    }
+    alarm 0; # reset alarm
+  };
+  alarm 0; # reset alarm
+  if (defined $@)
+  {
+    if ($@ =~ /timeout/)
+    {
+      print "timed out]";
+    }
+    else
+    {
+      print "Error! " . @! . "\n";
+    }
+  }
+  return $result;
+}
+## searchPort() ##
+
+
+## @function searchURL
+#
+sub searchURL
+{
+  # we use wget as it is simple, and doesn't require Perl module changes
+  my $cmd = 'wget -q -O - "' . $search_url . '"';
+  &printDebug($cmd);
+  my $content = `$cmd`;
+  my $result = &parseInstructions($content);
+  return $result;
+}
+## searchURL() ##
+
+
+## @function shellCommand()
+#
+sub shellCommand
+{
+  my ($cmd, $background) = @_;
+  my $result = '';
+  if ($debug)
+  {
+    &printDebug('shellCommand("' . $cmd . '")');
+  }
+  elsif (defined $background)
+  {
+    $result = `$cmd 2>&1 &`;
+  }
+  else
+  {
+    $result = `$cmd 2>&1`;
+  }
+  return $result;
+}
+## shellCommand() ##
+
+__END__
+=head1 NAME
+sample - Using GetOpt::Long and Pod::Usage
+=head1 SYNOPSIS
+sample [options] [file ...]
+ Options:
+   -help            brief help message
+   -man             full documentation
+=head1 OPTIONS
+=over 8
+=item B<-help>
+Print a brief help message and exits.
+=item B<-man>
+Prints the manual page and exits.
+=back
+=head1 DESCRIPTION
+B<This program> will read the given input file(s) and do something useful with the contents thereof.
+=cut
Index: gs2-extensions/parallel-building/trunk/src/opt/Perseus/perseus.pl
===================================================================
--- gs2-extensions/parallel-building/trunk/src/opt/Perseus/perseus.pl	(revision 29649)
+++ gs2-extensions/parallel-building/trunk/src/opt/Perseus/perseus.pl	(revision 29649)
@@ -0,0 +1,509 @@
+#!/usr/bin/perl
+
+# Pragma
+use strict;
+use warnings;
+$|++; # Unbuffer STDOUT
+
+# Perl Built-in Modules
+use Getopt::Long;
+use IO::Socket::INET;
+use LWP::Simple;
+use Pod::Usage;
+
+my $txt_buffer = '';
+
+my $start_time = time();
+&printBuffer("[" . localtime($start_time) . "]\n");
+&printBuffer("===== Persus =====\n");
+&printBuffer("To slay a Medusa you need an appropriately shiney shield - this is\n";
+&printBuffer("that shield.\n");
+&printBuffer("\n");
+
+# 1. Configuration
+my $debug = 0;
+my $help = 0;
+my $kill_delay = 5;
+my $listen_time = 60;
+my $man = 0;
+my $search_path = '';
+my $search_port = 39875;
+my $search_url = 'http://www.cms.waikato.ac.nz/~jmt12/perseus.txt';
+my $log_path = '/tmp/perseus.log';
+GetOptions ('debug'         => \$debug,
+            'kill_delay=i'  => \$kill_delay,
+            'listen_port=i' => \$search_port,
+            'listen_time=i' => \$listen_time,
+            'path=s'        => \$search_path,
+            'url=s'         => \$search_url,
+            'log=s'         => \$log_path,
+            'help|?'        => \$help,
+            man             => \$man
+           )
+or pod2usage(2);
+if ($help)
+{
+  pod2usage(1);
+}
+if ($man)
+{
+ pod2usage(-exitval => 0, -verbose => 2);
+}
+&printBuffer(" * Configuration\n");
+&printBuffer("   - Debug? " . ($debug ? "Yes" : "No") . "\n");
+&printBuffer("   - Search path: " . $search_path . "\n");
+&printBuffer("   - Search URL: " . $search_url . "\n");
+&printBuffer("   - Search port: " . $search_port . "\n");
+&printBuffer("   - Listen time: " . $listen_time . " seconds\n");
+&printBuffer("   - Delay before KILL: " . $kill_delay . " seconds\n");
+&printBuffer("   - Log path: " . $log_path . "\n");
+
+# 2. Search
+&printBuffer(" * Looking for Instructions\n");
+my $instructions = [];
+&printBuffer("   - Listen on port... ");
+if ($search_port > 0)
+{
+  if (&searchPort())
+  {
+    &printBuffer("Contacted\n");
+  }
+  else
+  {
+    &printBuffer("No contact\n");
+  }
+}
+else
+{
+  &printBuffer("Skipped\n");
+}
+&printBuffer("   - Search for internet page... ");
+if (!scalar(@{$instructions}))
+{
+  if (&searchURL())
+  {
+    &printBuffer("Found\n");
+  }
+  else
+  {
+    &printBuffer("Not found\n");
+  }
+}
+else
+{
+  &printBuffer("Skipped\n");
+}
+&printBuffer("   - Search for sentinel file... ");
+if (defined $search_path && $search_path ne '' && !scalar(@{$instructions}))
+{
+  if (&searchPath())
+  {
+    &printBuffer("Found\n");
+  }
+  else
+  {
+    &printBuffer("Not found\n");
+  }
+}
+else
+{
+  &printBuffer("Skipped\n");
+}
+
+# 3. Action
+if (scalar(@{$instructions}))
+{
+  &printBuffer(" * Processing Instructions\n");
+  my @instructions2;
+  # - terms and kills first
+  my $instruction_ptr = shift(@{$instructions});
+  while (defined $instruction_ptr)
+  {
+    my @instruction = @{$instruction_ptr};
+    &printDebug("[instruction=" . $instruction[0] . ':' . $instruction[1] . "]");
+    if ($instruction[0] eq 'pid')
+    {
+      &commandTerminate($instruction[1]);
+    }
+    else
+    {
+      push(@instructions2, $instruction_ptr);
+    }
+    $instruction_ptr = shift(@{$instructions});
+  }
+  # - then slays
+  $instruction_ptr = shift(@instructions2);
+  while (defined $instruction_ptr)
+  {
+    my @instruction = @{$instruction_ptr};
+    if ($instruction[0] eq 'user')
+    {
+      &commandSlay($instruction[1]);
+    }
+    else
+    {
+      push(@{$instructions}, $instruction_ptr);
+    }
+    $instruction_ptr = shift(@instructions2);
+  }
+  # - then commands (reboot)
+  $instruction_ptr = shift(@{$instructions});
+  while (defined $instruction_ptr)
+  {
+    my @instruction = @{$instruction_ptr};
+    if ($instruction[0] eq 'cmd' && $instruction[1] eq 'reboot')
+    {
+      &commandReboot();
+    }
+    else
+    {
+      push(@instructions2, $instruction_ptr);
+    }
+    $instruction_ptr = shift(@{$instructions});
+  }
+  # - left overs
+  foreach $instruction_ptr (@instructions2)
+  {
+    my @instruction = @{$instruction_ptr};
+    &printBuffer("Error! Unrecognized instruction \"" . $instruction[0] . ":" . $instruction[1] . "\"\n");
+  }
+}
+else
+{
+  &printBuffer(" * No Instructions!\n");
+}
+
+# 4. Complete!
+my $end_time = time();
+my $duration = $end_time - $start_time;
+&printBuffer("===== Complete in " . $duration . " seconds =====\n");
+&printBuffer("[" . localtime($end_time) . "]\n\n");
+
+# 5. Try and write to log path (hopefully before a reboot shuts us down)
+#    Needs to be in eval{} in case filesystem is non-responsive
+eval
+{
+  local $SIG{ALRM} = sub { die 'timeout' };
+  alarm 5; # This is a lifetime for file writing
+  if (open(LOGOUT, '>:utf8', $log_path))
+  {
+    print LOGOUT $txt_buffer;
+    close (LOGOUT);
+  }
+  else
+  {
+    print "Error! Failed to open log for writing\n";
+  }
+  alarm 0;
+};
+alarm 0;
+if (defined $@ && $@ ne '')
+{
+  print "Error! Failed to write log - " . $@ . ":" . $! . "\n";
+}
+
+exit;
+
+## @function
+#
+sub printBuffer
+{
+  my ($msg) = @_;
+  print $msg;
+  if (defined $log_path && $log_path ne '')
+  {
+    $txt_buffer .= $msg;
+  }
+}
+## printBuffer() ##
+
+## @function commandIsRunning
+#
+sub commandIsRunning
+{
+  my ($pid) = @_;
+  my $result == 1;
+  # yeah - timeout this command too, as I don't know if PS is hang-safe
+  eval
+  {
+    local $SIG{ALRM} = sub { die 'timeout' };
+    alarm 5; # This is a lifetime for file writing
+    $result = `ps -p $pid > /dev/null; echo $?`;
+    chomp($result);
+    alarm 0;
+  };
+  alarm 0;
+  if (defined $@ && $@ ne '')
+  {
+    &printBuffer("[ps timed out] ");
+  }
+  return ($result == 0);
+}
+## commandIsRunning() ##
+
+## @function commandReboot
+#
+# Wait five minutes then reboot the machine
+#
+sub commandReboot
+{
+  &printBuffer(" - rebooting\n");
+  &printBuffer(&shellCommand('shutdown -r +5', 1));
+}
+## commandReboot ##
+
+## @function commandSlay
+#
+sub commandSlay
+{
+  my ($user) = @_;
+  &printBuffer(" - slay all processes by: " . $user . "\n");
+  $user =~ s/"//g;
+  &printBuffer(&shellCommand('slay -clean "' . $user . '"'));
+}
+## commandSlay() ##
+
+## @function commandTerminate
+#
+sub commandTerminate
+{
+  my ($pid) = @_;
+  &printBuffer(" - terminate process: " . $pid . "... ");
+  # send SIGTERM
+  &printBuffer(&shellCommand('kill -s SIGTERM ' . $pid));
+  # wait delay seconds
+  sleep($kill_delay);
+  # see if process still there
+  if (&commandIsRunning($pid))
+  {
+    &printBuffer("Failed\n");
+    &printBuffer(" - kill process: " . $pid . "... ");
+    &printBuffer(&shellCommand('kill -s SIGKILL ' . $pid));
+    sleep($kill_delay);
+    if (&commandIsRunning($pid))
+    {
+      &printBuffer("Failed\n");
+    }
+    else
+    {
+      &printBuffer("Killed\n");
+    }
+  }
+  else
+  {
+    &printBuffer("Terminated\n");
+  }
+  # if it is still running then it must be uninterruptable... nothing we can
+  # do from here
+}
+## commandTerminate() ##
+
+
+## @function parseInstructions
+#
+sub parseInstructions
+{
+  my ($content) = @_;
+  my $instruction_count = 0;
+  while ($content =~ s/(pid|user|cmd)\:([^\s]+)//i)
+  {
+    my $type = lc($1);
+    my $value = $2;
+    push(@{$instructions}, [$1, $2]);
+    $instruction_count++;
+  }
+  return $instruction_count;
+}
+## parseInstructions() ##
+
+
+## @function printDebug()
+#
+sub printDebug
+{
+  my ($msg) = @_;
+  if ($debug)
+  {
+    &printBuffer("[DEBUG] " . $msg . " [" . time() . "]\n");
+  }
+}
+## printDebug() ##
+
+
+## @function searchPath()
+#
+sub searchPath
+{
+  my $result = 0;
+  # A user can ask us to do stuff by dumping a file here
+  eval
+  {
+    local $SIG{ALRM} = sub { die 'timeout' };
+    alarm $listen_time;
+    &printBuffer("[opening... ");
+    # read instructions (<type>:<value>\n) from the file
+    if (open(FIN, '<:utf8', $search_path))
+    {
+      &printBuffer("reading... ");
+      my $content;
+      sysread(FIN, $content, -s $search_path);
+      &printBuffer("parsing... ");
+      $result = &parseInstructions($content);
+      close(FIN);
+      # remove the file (if we can)
+      &printBuffer("deleting... ");
+      unlink($search_path);
+      &printBuffer("complete] ");
+    }
+    else
+    {
+      &printBuffer("failed] ");
+    }
+    alarm 0; # reset alarm
+  };
+  alarm 0; # reset alarm
+  if (defined $@ && $@ ne '')
+  {
+    if ($@ =~ /timeout/)
+    {
+      &printBuffer("timed out] ");
+    }
+    else
+    {
+      &printBuffer("error] ");
+    }
+  }
+  return $result;
+}
+## searchPath() ##
+
+
+## @function searchPort
+#
+sub searchPort
+{
+  my $result = 0;
+  # timeout isn't implemented in Perl sockets, so we cheat and use an alarm
+  # that interrupts an eval block
+  eval {
+    local $SIG{ALRM} = sub { die 'timeout' };
+    alarm $listen_time;
+    my $socket = IO::Socket::INET->new(Proto     => 'tcp',
+                                       LocalPort => $search_port,
+                                       Listen    => 1,
+                                       ReuseAddr => 1
+                                      );
+    if (defined $socket)
+    {
+      &printBuffer("[listening... ");
+      while (my $client = $socket->accept())
+      {
+        &printBuffer("connected... ");
+        $client->autoflush(1);
+        my $line;
+        while ($line = <$client>)
+        {
+          &printBuffer("receiving... ");
+          $result += &parseInstructions($line);
+        }
+        close $client;
+        &printBuffer("complete] [listening... ");
+      }
+    }
+    else
+    {
+      &printBuffer("failed] ");
+    }
+    alarm 0; # reset alarm
+  };
+  alarm 0; # reset alarm
+  if (defined $@ && $@ ne '')
+  {
+    if ($@ =~ /timeout/)
+    {
+      &printBuffer("timed out] ");
+    }
+    else
+    {
+      &printBuffer("error] ");
+    }
+  }
+  return $result;
+}
+## searchPort() ##
+
+
+## @function searchURL
+#
+sub searchURL
+{
+  my $result = 0;
+  &printBuffer("[downloading... ");
+  my $content = get($search_url);
+  if (defined $content)
+  {
+    &printBuffer("parsing... ");
+    $result = &parseInstructions($content);
+    &printBuffer("complete] ");
+  }
+  else
+  {
+    &printBuffer("failed] ");
+  }
+  return $result;
+}
+## searchURL() ##
+
+
+## @function shellCommand()
+#
+sub shellCommand
+{
+  my ($cmd, $background) = @_;
+  my $result = '';
+  # timeout all shell commands
+  eval
+  {
+    local $SIG{ALRM} = sub { die 'timeout' };
+    alarm 5; # This is a lifetime for file writing
+    if ($debug)
+    {
+      &printDebug('shellCommand(\'' . $cmd . '\')');
+    }
+    elsif (defined $background)
+    {
+      $result = `$cmd 2>&1 &`;
+    }
+    else
+    {
+      $result = `$cmd 2>&1`;
+    }
+    alarm 0;
+  };
+  alarm 0;
+  if (defined $@ && $@ ne '')
+  {
+    &printBuffer("[shell command timed out] ");
+  }
+  return $result;
+}
+## shellCommand() ##
+
+__END__
+=head1 NAME
+sample - Using GetOpt::Long and Pod::Usage
+=head1 SYNOPSIS
+sample [options] [file ...]
+ Options:
+   -help            brief help message
+   -man             full documentation
+=head1 OPTIONS
+=over 8
+=item B<-help>
+Print a brief help message and exits.
+=item B<-man>
+Prints the manual page and exits.
+=back
+=head1 DESCRIPTION
+B<This program> will read the given input file(s) and do something useful with the contents thereof.
+=cut
Index: gs2-extensions/parallel-building/trunk/src/opt/Perseus/perseusclient.pl
===================================================================
--- gs2-extensions/parallel-building/trunk/src/opt/Perseus/perseusclient.pl	(revision 29649)
+++ gs2-extensions/parallel-building/trunk/src/opt/Perseus/perseusclient.pl	(revision 29649)
@@ -0,0 +1,73 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use IO::Socket::INET;
+
+print "===== Perseus Client =====\n";
+
+my $host = 'localhost';
+my $port = 39875;
+my $talk_time = 60; # Sixty second timeout
+my $retry_time = 5;
+
+if (!defined $ARGV[0])
+{
+  die("Usage: perseusclient.pl \"<cmd1> [<cmd2> ...]\"\n");
+}
+my @commands = split(/\s/, $ARGV[0]);
+
+print " * Sending commands to: " . $host . ":" . $port . "...\n";
+
+my $not_sent = 1;
+while ($not_sent)
+{
+  print " - connecting... ";
+  eval
+  {
+    local $SIG{ALRM} = sub { die 'timeout' };
+    alarm $talk_time;
+    my $socket = IO::Socket::INET->new(PeerHost  => $host,
+                                       PeerPort  => $port,
+                                       Proto     => 'tcp'
+                                      );
+    if (defined $socket)
+    {
+      foreach my $command (@commands)
+      {
+        $socket->send($command . "\n") or die "couldn't send anything";
+      }
+      close($socket);
+      $not_sent = 0; # Sent successfully (hopefully)
+      print "sent!\n";
+    }
+    else
+    {
+      print "failed\n";
+    }
+    alarm 0; # reset alarm
+  };
+  alarm 0; # reset alarm
+  if (defined $@ && $@ ne '')
+  {
+    if ($@ =~ /timeout/)
+    {
+      print "timed out\n";
+    }
+    else
+    {
+      print "Error:" . $@ . "\n";
+    }
+  }
+  if ($not_sent)
+  {
+    print " - retrying in " . $retry_time . " seconds... \n";
+    sleep($retry_time);
+  }
+}
+
+print "Commands sent!\n\n";
+
+exit;
+
