Question

I trie to make a Perlscript where only one instance is running, and the next call of the script sends the payload to the queue of the first one. If the queue is done the script should terminate. I tried this with sockets - they should be blocking... I use Win7

If I call this script with test1 and test2 in two different command windows booth tell me they open the port and the queue echo back but don't terminate.

use 5.14.2;
use strict;
use warnings;
#Filename: singleInstance.pl
use Socket;
use threads;
use Thread::Queue;

sub sendToPort($);

my $q = Thread::Queue->new(); # A new empty queue
# Worker thread
my $thr = threads->create(
  sub {
    # Thread will loop until no more work
    while (defined(my $item = $q->dequeue())) {
      say $item;
      sleep 10;
    }
    die "all done";
  }
);

my $string = shift;
my $proto = getprotobyname('tcp');
my $port = 7890;
my $server = "localhost";

socket(SOCKET, PF_INET, SOCK_STREAM, $proto)
   or die "Can't open socket $!\n";
setsockopt(SOCKET, SOL_SOCKET, SO_REUSEADDR, 1)
   or die "Can't set socket option to SO_REUSEADDR $!\n";

bind( SOCKET, pack_sockaddr_in($port, inet_aton($server)))
   or die sendToPort($string);

listen(SOCKET, 5) or die "listen: $!";
print "SERVER started on port $port\n";

$q->enqueue($string);

# accepting a connection
my $client_addr;
while ($client_addr = accept(NEW_SOCKET, SOCKET)) {
  # send them a message, close connection
  my $string = <NEW_SOCKET>;
  $q->enqueue($string);
  close NEW_SOCKET;
}

sub sendToPort($){
  # create the socket, connect to the port
  socket(SOCKET,PF_INET,SOCK_STREAM,(getprotobyname('tcp'))[2])
     or die "Can't create a socket $!\n";
  connect( SOCKET, pack_sockaddr_in($port, inet_aton($server)))
     or die "Can't connect to port $port! \n";
  print SOCKET $string;
  close SOCKET or die "close: $!";
  die "send to open script";
}
Was it helpful?

Solution

It seams that with Windows Port blocking don't work and also flock on the script if the script should be used when locked. I used a lock on a file instead. If the queue is done it exit the script. It's not the best solution, but it works for me so I didn't researched it more.

use 5.14.2;
use strict;
use warnings;
use Socket;
use threads;
use Thread::Queue;
use File::Flock::Tiny;

sub sendToPort($);

my $string = shift;
my $proto = getprotobyname('tcp');
my $port = 7890;
my $server = "localhost";

my $pid = File::Flock::Tiny->write_pid('cl_sv.pid') or do
{
  say "in lock. send to daemon: $string";
  sendToPort($string);  
  exit(0);
};

my $q = Thread::Queue->new(); # A new empty queue
# Worker thread
my $thr = threads->create(
  sub {
    # Thread will loop until no more work
    while (defined(my $item = $q->dequeue())) {
      say $item;
      sleep 5;
    }
    exit;
  }
);

my $socket;
socket($socket, PF_INET, SOCK_STREAM, $proto)
   or die "Can't open socket $!\n";
setsockopt($socket, SOL_SOCKET, SO_REUSEADDR, 1)
   or die "Can't set socket option to SO_REUSEADDR $!\n";
bind( $socket, pack_sockaddr_in($port, inet_aton($server)))
   or die;

listen($socket, 5) or die "listen: $!";
print "SERVER started on port $port\n";

$q->enqueue($string, undef);

# accepting a connection
my $client_addr;
my $new_socket;
while ( ($client_addr = accept($new_socket, $socket))) {
  # send them a message, close connection
  my $string = <$new_socket>;
  my $remove_undef= $q->extract(-1);
  $q->enqueue($string, undef);
  close $new_socket;
}

sub sendToPort($){
  # create the socket, connect to the port
  print "sendToPort";
  socket($socket,PF_INET,SOCK_STREAM,(getprotobyname('tcp'))[2])
     or die "Can't create a socket $!\n";
  connect( $socket, pack_sockaddr_in($port, inet_aton($server)))
     or die "Can't connect to port $port! \n";
  print $socket $string;
  close $socket or die "close: $!";
  #die "send to open script";
}
Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top