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);