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
}
[download]

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.