MultiThreaded whois app

I created a multithreaded whois program with perl. It is much faster wtih threads. The problem is that it hangs on average 1 out of ever 4 times you run the program against a list of 100 domains.


# ***** START CODE *****
#!/usr/bin/perl
use IO::Socket;
use warnings;
use threads;
use threads::shared;

#Start timer
my $before = time();

#Variables
my $tld=$ARGV[1];
my $tcount=5;
my @out : shared;
my @err : shared;

#Open domain list file and assign it to an array
open(DOM, $ARGV[0]);
my @domains = <DOM>;
close(DOM);

#Calculate domains per thread count
my $elements = @domains;
my $num = int($elements/$tcount)+1;

#Split domains into equal parts and start a new thread for each part
print "Scanning $ARGV[0] ($elements domains)...";
for(my $i=0; $i<$tcount; $i++)
{
  @{"d$i"} = splice(@domains,0,$num);
  ${"t$i"} = threads->new(\&loop, $i);
}
for(my $j=0; $j<$tcount; $j++){ ${"t$j"}->join;}

sub loop
{
  my ($x) = @_; #Get thread ID
  my $el=@{"d$x"};
  print "\n$x - start ($el domains)\n";

  #Loop through each domain
  foreach(@{"d$x"})
  {  
    chomp;
    my $dm=lc($_);
    print "( $dm $x-1)";
    my $status="UNKNOWN";

    #Query registry whois database
    $sock=IO::Socket::INET->new(Proto=>'tcp',PeerAddr=>"whois.crsnic.net:43",Timeout=>1) or error($sock,$dm,$!,"Connect");
    $sock->print("domain $dm.$tld\n") or error($sock,$dm,$!,"Print");
    my @result=$sock->getlines or error($sock,$dm,$!,"Get");
    close($sock) or error($sock,$dm,$!,"Close");
    if(scalar(@result)<1){ error($sock,$dm,"Empty","Result"); }
 
    #Scan whois results for needed info
    foreach(@result)
    {
      if(/Status: (.*)/){ $status=$1; }
    }
   
    push(@out,"$dm\t$status\n");

NEXT:
    print "( $dm $x-2)";
  }
  print "\n$x - fin\n";
}

sub error
{
  my ($sck,$dom,$er,$type) = @_;
  print "\nERROR $type: $dom --> $er\n";
  if (defined($sck)){ close($sck); }
  push(@err,"$dom\n");
  goto NEXT;
}

print "\nCleaning up...\n";

#Output results to file
open(OUT,">> out");
print OUT (@out);
close(OUT);

#Output errors to file
open(ERR,">> $tld.err");
print ERR (@err);
close(ERR);

#Cleanup
@out = ();
for(my $i=0; $i<$tcount; $i++) {@{"d$i"}=(); }

#Output completed time
my $total = time()-$before;
print "\nCompleted in $total seconds.\n\n";

# ***** END CODE *****


It seems to always freeze after 3 batches. It prints "x - fin" where x is the thread id then hangs .  It seems to show the results like this for 100 domains

0 - start (21 domains)

1 - start (21 domains)

2 - start (21 domains)

3 - start (21 domains)

4 - start (16 domains)

( domain1 3-1 ) ( domain1 3-2 )( domain2 3-1 )( domain1 3-2 ) ...
3-fin
( domain1 0-1 ) ( domain1 0-2 )( domain2 0-1 )( domain1 0-2 )...
0-fin
( domain1 2-1 ) ( domain1 2-2 )( domain2 2-1 )( domain1 2-2 ) ...
2-fin
//This is where the program hangs. I tried letting it sit for a while, but still nothing. It doesn't happen every time. I tried running the program against a file with 100 domains and on average it hangs about every 4th run. Any ideas?