source: gs2-extensions/parallel-building/trunk/src/opt/Perseus/perseusclient.pl@ 29649

#!/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;