Perlscript with only one instance running, the next call add to queue of the first

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";
}

You can [daemonize server](http://search.cpan.org/dist/Net-Server/lib/Net/Server/Daemonize.pm) — mpapec, Apr 15 '14 at 07:38
Sorry, I don't know how Net::Server::Daemonize can help me. I want to start a worker, and when it is called again it adds to the queue and terminates when the queue is done. — Lebewesen, Apr 15 '14 at 08:21
It looks like you want traditional server, since you're already listening to the port and waiting to serve clients. — mpapec, Apr 15 '14 at 09:07
I thought about [this post](http://stackoverflow.com/questions/14639181/in-perl-5-how-to-queue-a-process-application-after-it-reaches-a-maximum-limit/14652070#14652070) (Daemonic Redesign). If the scipt is started for the first time it behaves like a server, any other time it should behave like a client. When the queue of the server is done the server should terminate itself. — Lebewesen, Apr 15 '14 at 12:08

score 0 · Accepted Answer · answered Apr 23 '14 at 08:14

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";
}

Perlscript with only one instance running, the next call add to queue of the first

1 Answers1