只运行一个实例的Perlscript，下一个调用将添加到第一个实例的队列中。

Question

我尝试制作一个Perlscript，其中只有一个实例正在运行，脚本的下一个调用将有效负载发送到第一个实例的队列中。如果队列完成，脚本应该终止。我用插座试过了-它们应该被堵住.我使用Win7

如果我在两个不同的命令窗口booth中用test1和test2调用这个脚本，告诉我它们打开端口并回显队列，但不要终止。

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

Answer 1

它接缝与Windows端口阻塞不工作，也羊群的脚本，如果应该使用时，锁定。我用了一个文件的锁。如果队列完成，则退出脚本。这不是最好的解决方案，但它对我有效，所以我没有更多地研究它。

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