alarm.pl to HTML.

index -|- end

Generated: Tue Feb 2 17:54:17 2010 from alarm.pl 2006/09/12 3.8 KB.

#!/Perl
# AIM: To try alarm function
# BUT NEVER GOT ANYTHING TO WORK WITH alarm !!!
# neither the STDIN test, nor any socket tests
# sockets can be set non-blocking, thus maybe alarm not needed?!!?
# but think alarm SECONDS does NOT function in WIN32
# from : http://experts.about.com/q/Perl-CGI-1045/Alarm-error.htm
# read : But alarm seems to be unsupported function in windows...
# i get the following error msg..
# The Unsupported function alarm function is unimplemented at TIMER3.PL line 3.
# from : http://www.fvwm.org/documentation/perllib/FVWM::Tracker::Scheduler.php?theme=default
# read : Note that alarm signals are not relable in some perl versions, on some systems and with
# some kind of applications, don't expect the alarm method to work at all.
use strict;
use warnings;
use IO::Socket;
use utf8;
use POSIX qw(:errno_h);
# sample code
# from : http://www.rocketaware.com/perl/perlfunc/alarm.htm, and
# from : http://www.perl.com/doc/manual/html/pod/perlfunc/alarm.html, and
# from : http://perldoc.perl.org/functions/alarm.html
#   eval {
#         local $SIG{ALRM} = sub { die "alarm\n" };       # NB \n required
#         alarm $timeout;
#         $nread = sysread SOCKET, $buffer, $size;
#         alarm 0;
#   };
#   die if $@ && $@ ne "alarm\n";       # propagate errors
#   if ($@) {
#      print "timed out... $@ ...\n";
#   } else {
#      print "didn't - no time out ... \n";
#   }
# my trial sample
print "Hello, World...\n";
my $dosock1 = 0; # switch sockets
my $timeout = 5;
my $buffer = '';
my $size = 12;
my $nread = 0;
# socket variables
my $client;
my $socket;
my $message;
# constants
my( $HOST ) = "localhost";
my( $PORT ) = "1234";
my( $BUFSIZE ) = "12";
eval {
   local $SIG{ALRM} = sub{print localtime(time());die"alarm\n"};
   print "waiting stdin for $timeout secs ... seems to NEVER timeout ... Ctrl+C to abort ...\n";
   alarm $timeout;
   print localtime(time()).' ';
   <>;
   alarm 0;
};
die if $@ && $@ ne "alarm\n";       # propagate errors
if ($@) {
   print "timed out...\n";
   exit(0);
}
else {
   print "didn't - no time out ...\n";
   exit(0);
}
if ($dosock1) {
   $socket = IO::Socket::INET->new(
        "Proto" => "tcp",
        "LocalPort" => "8177",
        "Listen" => 1) or die "ERROR: NO SOCKET - $!\n";
} else {
   #$socket = IO::Socket::INET->new(
   #   Proto =>  "tcp",
   #   PeerAddr =>  $HOST,
   #   PeerPort =>  "gdb(" . $PORT . ")",
   #   Blocking =>  0 ) or die "ERROR: NO SOCKET - $!\n";
   $socket = IO::Socket::INET->new(
      Proto =>  "tcp",
      LocalPort =>  "8177" ) or die "ERROR: NO SOCKET - $!\n";
}
# put the socket in UTF-8 mode.
binmode $socket, ":utf8";
eval {
      local $SIG{ALRM} = sub { die "alarm\n" };       # NB \n required
      alarm $timeout;
      $nread = sysread( $socket, $buffer, $BUFSIZE );
      alarm 0;
   };
die if $@ && $@ ne "alarm\n";       # propagate errors
if ($@) {
   print "timed out...\n";
   exit(0);
}
else {
   print "didn't - no time out ...\n";
   if ($nread) {
      print "nread = [$nread] ...\n";
   }
   exit(0);
}
$socket = IO::Socket::INET->new(
        "Proto" => "tcp",
        "LocalPort" => "8177",
        "Listen" => 1) or die "ERROR: NO SOCKET - $!\n";
print "Waiting for connection ... $timeout secs ...\n";
# Blocks until connection is made
###$client = $socket->accept();
eval {
      local $SIG{ALRM} = sub { die "alarm\n" };       # NB \n required
      alarm $timeout;
      ##   $nread = sysread SOCKET, $buffer, $size;
      ## Blocks until connection is made
      $client = $socket->accept();
      alarm 0;
   };
die if $@ && $@ ne "alarm\n";       # propagate errors
if ($@) {
   print "timed out... $@ ...\n";
}
else {
   print "didn't - no time out ... \n";
   print "Connection received\n";
   # Blocks until message is received
   $message = <$client>;
   print "Incoming message: $message\n";
   close $client;
}
close $socket;
exit(0);

index -|- top

checked by tidy  Valid HTML 4.01 Transitional