This was interesting, I had not done IPC stuff yet.
I redid some of your logic since I think some of it was
uncessary. It also seemed to me that the SIG handlers were
uncecessary, I always find it more work that it is worth
to keep track of the childred, and I dont think it
is really required here. The first part is unchange except
for the children hash: use strict;
use POSIX;
use IPC::Shareable;
use Net::DNS;
use Data::Dumper;
$|=1;
my $glue = 'data';
my %options = (
create => 'yes',
destroy => 'yes',
);
my %mxs;
my $knot = tie %mxs, 'IPC::Shareable', $glue, { %options } or
die "server: tie failed\n";
my @urls = <>;
my %hash;
for (@urls) {
chomp;
my ($username, $domain) = split (/\@/);
push (@{$hash{$domain}}, $_);
};
my $PREFORK = 25; # number of children to maintain
my @doms = keys %hash;
I added Data::Dumper just for easily displaying
the data of our multi dimensional hash %mxs. And I added
'strict' as every good human should :)
The next part is the most drastic change. Is is the rest of
the main function (that the parent will execute):# define the anon arrays here instead of in the child
foreach(@doms)
{
$mxs{$_} = [];
}
for( 1..$PREFORK )
{
last unless @doms > 0;
my $url = shift @doms;
child( $url ) if !fork();
}
wait(); # wait till one dies;
my $kid;
{
if( @doms > 0 )
{
my $url = shift @doms;
child( $url ) if !fork();
}
$kid = wait();
redo unless $kid == -1;
}
print Data::Dumper->Dump([\%mxs]);
exit;
First since we want each hash key to be an array (to get rid of
the split/join junk) it seems we have to create the anon
arrays in the parent. I always got fatal errors if I tried
to do it from the child. I am not saying it can't be done,
because I dont know ... but I couldn't figure out how to do
it.
In the first for loop we call 'child' for each child as long
as there are more domains to search for. So if there are
more doms than $PREFORK we have to wait for one to die
before we fork off another one. The 'wait' is blocking and
will wait for any child to die. Then we go into a anonomous
block and keep 'redo'ing until we have forked of a child
for every domain and all the children have died. Finally
once all the children are dead we display the results via
Data::Dumper.
The last bit is the child function:sub child
{
my $url = shift;
my $glue = 'data';
my %options = (
create => 'no',
destroy => 'no',
);
my %mxs;
my $knot = tie %mxs, 'IPC::Shareable', $glue, { %options } or
die "client: tie failed\n";
$knot->shlock;
push( @{$mxs{$url}}, map { $_->exchange } mx($url));
$knot->shunlock;
exit;
}
This code is similar to yours, just a trimmed a bit.
First we open up the shared memory segment,then call the
mx function with the passed in URL. The list result of that
is mapped to get out the data we want, and the list returned
from map is pushed on the end of the anonymous array for
our url in the mxs hash.
I have to mention though that I have never done IPC stuff
before, so I might be missing some of the subtleties, but this
code worked like a champ for me.
I hope this helps.
And here is the code all together just to make is
easier to cut and past:use strict;
use POSIX;
use IPC::Shareable;
use Net::DNS;
use Data::Dumper;
$|=1;
my $glue = 'data';
my %options = (
create => 'yes',
destroy => 'yes',
);
my %mxs;
my $knot = tie %mxs, 'IPC::Shareable', $glue, { %options } or
die "server: tie failed\n";
my @urls = <>;
my %hash;
for (@urls) {
chomp;
my ($username, $domain) = split (/\@/);
push (@{$hash{$domain}}, $_);
};
my $PREFORK = 25; # number of children to maintain
my @doms = keys %hash;
# define the anon arrays here instead of in the child
foreach(@doms)
{
$mxs{$_} = [];
}
for( 1..$PREFORK )
{
last unless @doms > 0;
my $url = shift @doms;
child( $url ) if !fork();
}
wait(); # wait till one dies;
my $kid;
{
if( @doms > 0 )
{
my $url = shift @doms;
child( $url ) if !fork();
}
$kid = wait();
redo unless $kid == -1;
}
print Data::Dumper->Dump([\%mxs]);
exit;
sub child
{
my $url = shift;
my $glue = 'data';
my %options = (
create => 'no',
destroy => 'no',
);
my %mxs;
my $knot = tie %mxs, 'IPC::Shareable', $glue, { %options } or
die "client: tie failed\n";
$knot->shlock;
push( @{$mxs{$url}}, map { $_->exchange } mx($url));
$knot->shunlock;
exit;
}
|