timeout not working in Perl script for function for some domains I'm pinging

Viewed 122

I can't figure out whats going on here. My example code:

#!/usr/bin/perl

use strict;
use Net::Ping;
use Time::Out qw(timeout) ;

my $p = Net::Ping->new();

my $domain = lc("play9112.com");

print qq|Doing $domain \n|;

my $ping_result = timeout 3 => sub {
    return $p->ping($domain,5);
} ;

unless ($ping_result) {
    print qq|Don't seem to be able to grab $domain! \n|;
} else {
    print qq|needs to delete...\n|; # delete is done below!
}

The above code works on about 99% of cases. But there are some domains it just locks up on, and doesn't "timeout"! As a test, instead of Time::Out, I tested it with just a normal eval {} block:

my $TIMEOUT_IN_SECONDS = 5;
eval {
    local $SIG{ALRM} = sub { die "alarm\n" };
    alarm($TIMEOUT_IN_SECONDS);

    $p->ping($domain,5);

    # do stuff that might timeout.
    alarm(0);
};
if ($@) {
    # handle timeout condition.
}

This seems to have the same problem. Can anyone point me in the right direction? There must be a quirk, or something I'm missing!

UPDATE: I just tried it with -d and get:

perl -d test-ping.cgi

Loading DB routines from perl5db.pl version 1.51
Editor support available.

Enter h or 'h h' for help, or 'man perldebug' for more help.

main::(test-ping.cgi:8):                my $p = Net::Ping->new();
  DB<1>

  DB<1>   n
main::(test-ping.cgi:11):               my $domain = lc("play9112.com");
  DB<1> n
main::(test-ping.cgi:13):               print qq|Doing $domain \n|;
  DB<1> n
Doing play9112.com
main::(test-ping.cgi:27):               my $TIMEOUT_IN_SECONDS = 5;
  DB<1>
main::(test-ping.cgi:28):               eval {
  DB<1>
main::(test-ping.cgi:29):                   local $SIG{ALRM} = sub { die "alarm\n" };
  DB<1>
main::(test-ping.cgi:30):                   alarm($TIMEOUT_IN_SECONDS);
  DB<1>
main::(test-ping.cgi:32):                   $p->ping($domain,5);
  DB<1>

It hangs after that last part. So its something in Net::Ping thats doing it :/

0 Answers
Related