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

Question

我尝试创建一个Perlscript，其中只有一个实例在运行，脚本的下一个调用将有效负载发送到第一个实例的队列。如果队列完成，脚本应该终止。我用插座试过了——它们应该会阻塞。。。我使用Win7

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

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