The code is as follows (the forking code is mostly borrowed from pg.626-627 of The Perl Cookbook
use Symbol; use POSIX; use IPC::Shareable; use Net::DNS; $| = 1; my $ppid = $$; my %options = ( destroy => 'yes', create => 'yes', ); my %mxs; my $knot = tie %mxs, 'IPC::Shareable', $ppid, { %options } or die "server: tie failed\n"; my @urls = <>; # Specify a filename on the command line with # a list of email addresses, one per line. for (@urls) { chomp; my ($username, $domain) = split (/\@/); push (@{$hash{$domain}}, $_); }; print "Sorted addresses by domain\n"; my $PREFORK = 25; # number of children to mainta +in my %children = (); # keys are current child proces +s IDs my $children = 0; # current number of children my @doms = keys %hash; # Fork off our children. for (1 .. $PREFORK) { my $url = shift(@doms); make_new_child($url) if $url; } # Install signal handlers. $SIG{CHLD} = \&REAPER; $SIG{INT} = \&HUNTSMAN; # And maintain the population. while (1) { sleep; # wait for a signal (i.e., child's + death) for ($i = $children; $i < $PREFORK; $i++) { my $url = shift(@doms); make_new_child($url) if $url; # top up the child poo +l } last unless @doms; } print "Done with URL list, waiting on remaining threads to finish...\n +"; # Wait for everyone to return do { $kid = waitpid(-1,&WNOHANG); } until $kid == -1; print "Sorted domains by mx server\n"; open (OUT, ">/tmp/mx.tmp"); # Make a report about what would # have happened if the rest of the # program were written for (keys %mxs) { my @deliver = (); my $mx = $_; my @domains = split(/\n/, $mxs{$mx}); for (@domains) { push (@deliver, @{$hash{$_}}) } print OUT "Sending to mx server $mx :\n"; print OUT join ("\n", @deliver), "\n"; } close (OUT); IPC::Shareable->clean_up; exit; sub make_new_child { my $url = shift; my $pid; my $sigset; # block signal for fork $sigset = POSIX::SigSet->new(SIGINT); sigprocmask(SIG_BLOCK, $sigset) or die "Can't block SIGINT for fork: $!\n"; die "fork: $!" unless defined ($pid = fork); if ($pid) { # Parent records the child's birth and returns. sigprocmask(SIG_UNBLOCK, $sigset) or die "Can't unblock SIGINT for fork: $!\n"; $children{$pid} = 1; $children++; return; } else { # Child can *not* return from this subroutine. $SIG{INT} = 'DEFAULT'; # make SIGINT kill us as it did be +fore # unblock signals sigprocmask(SIG_UNBLOCK, $sigset) or die "Can't unblock SIGINT for fork: $!\n"; print "Looking up MX server for $url\n"; my @mx = mx($url); my $mx = join("|", map { $_->exchange} @mx); # Making a key wi +th # join instead of references. yuk. $mx ||= $url; $knot->shlock; # push (@{$mxs{$mx}}, $url); # This doesn't work due to tie # problems with IPC::Shareable $mxs{$mx} .= "$url\n"; # So we do this instead (bleah) $knot->shunlock; print "Found MX servers for $url\n"; exit; } } sub REAPER { # takes care of dead children $SIG{CHLD} = \&REAPER; my $pid = wait; $children --; delete $children{$pid}; } sub HUNTSMAN { # signal handler for SIGINT local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children kill 'INT' => keys %children; $knot->destroy; IPC::Shareable->clean_up; exit; # clean up with dignity }
For now I am not worrying about storing the preference of the MX server. And when a domain like foo.bar.com doesn't have an MX record, I am just using foo.bar.com as the MX server. because I don't know how to use Net::DNS recursively.

In reply to RE: Forking and sharing variables by httptech
in thread Forking and sharing variables by httptech

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.