Ok, that's the simpler version. I don't know if it can be done with Parallel::ForkManager ( and don't really care ), so here's a version
using my own Forking::Amazing. There are some tune-able parameters that can be adjusted for best performance in your situation.
It is pretty simple with a good forking package :)
#!/usr/bin/perl
use strict; # https://perlmonks.org/?node_id=11107627
use warnings;
use IO::Socket;
use Forking::Amazing;
my $maxforks = 20; # tune these ...
my $clientsperchild = 300;
my $port = 6666;
my $listen = IO::Socket::INET->new(LocalPort => $port,
Listen => 20, Reuse => 1) or die "$@ on listen create";
Forking::Amazing::run
$maxforks,
sub
{
print "child $$\n";
process( scalar $listen->accept or return [] ) for 1 .. $clientspe
+rchild;
return [];
},
sub { push @Forking::Amazing::ids, 1 },
(1) x $maxforks;
sub process # custom code goe
+s in here
{
my $socket = shift;
my $query = <$socket> // return []; # read query
print $socket "prefork $$ is answering: $query"; # reply
}
And here's the program I used to stress test it. I've been running it with 100 forks and 100 transactions per fork for a total of 10,000 transactions.
#!/usr/bin/perl
use strict;
use warnings;
use IO::Socket;
use Forking::Amazing;
my $forks = shift // 1;
my $sends = shift // 1;
my $totalerrors = 0;
my $transactions = 0;
Forking::Amazing::run
$forks,
sub
{
my $errors = 0;
my $trans = 0;
for ( 1 .. $sends )
{
my $s = IO::Socket::INET->new('localhost:6666') or die;
my $key = join '', map +('a'..'z')[rand 26], 1 .. 10;
print $s "foo|$key\n";
my $answer = join '', <$s>;
$answer =~ /$key/ or $errors++;
print $answer;
close $s;
$trans++;
}
return [ $errors, $trans ];
},
sub
{
$totalerrors += $_[1][0] // 0;
$transactions += $_[1][1] // 0;
},
1 .. $forks;
print "total errors: $totalerrors transactions: $transactions\n";
And here's the Forking::Amazing module
And if you've read this far, here's a version that does variable numbers of children depending on how busy it gets.
This version tests OK, but there my be some corner cases I haven't discovered yet. It also has parameters that will probably need tweaking.
|