#!/usr/bin/perl -w

use strict;
use Carp;
my $host = "www.perlmonks.com";
my $timeout = 10; #sec

#Stolen from Net::Ping
use FileHandle;
use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW PF_INET
               inet_aton sockaddr_in );
my $proto_num = (getprotobyname('tcp'))[2] ||
            croak("Can't get tcp protocol by name");
my $port_num = (getservbyname('echo', 'tcp'))[2] ||
            croak("Can't get tcp echo port by name");
my $fh = FileHandle->new();

my $ip = inet_aton($host) || croak("Cant resolve: $!"); 

socket($fh, &PF_INET(), &SOCK_STREAM(), $proto_num) ||
        croak("tcp socket error - $!");
my $saddr = sockaddr_in($port_num, $ip);
$SIG{'ALRM'} = sub { die };
alarm($timeout);        # Interrupt connect() if we have to
            
my $ret = 0;               # Default to unreachable
eval <<'EOM' ;
   exit unless connect($fh, $saddr);
   $ret = 1;
EOM
alarm(0);
$fh->close();

exit $ret;
[download]