Update:

Note: alarm may not work on all versions of Perl in Windows, and it may not be able to interrupt everything.

In ActiveState Perl 5.6.1, I get "The Unsupported function alarm function is unimplemented".

In ActiveState Perl 5.8.0, alarm was unable to interrupt $str = <STDIN>.

You answered your own question :)

an alarm routine will trigger and exit the script

Ironically, the link you gave has an example of how to use alarm w/o it exiting by rerouting the encryptions, i mean the signal handler. :)

#!/usr/bin/perl -w
use strict;

my $input = &my_stdin(
   prompt =>"Enter some text: ",
   timeout => 3,
   handler => \&my_alarm );


print "You entered: $input \n";

sub my_stdin {

   use Term::ReadKey;
   $| = 1;     #turn buffering off so we can see our print below
   my %args    = @_;
   my ($output,$key );
   my $prompt  = $args{'prompt'};
   my $timeout = $args{'timeout'};
   my $toh     = $args{'handler'};  # ref to a handler

   $SIG{ALRM} = $toh || sub { print "Timeout\n"; exit;};
   alarm($timeout);
   print $prompt;
   ReadMode 4;
   while(1){
       if(defined($key = ReadKey(-1))){
       my $val = ord $key;
       # 8 is backspace 10 and 13 are
       $output .= $key unless $val == 8 || $val == 10 || $val == 13;
       #echo to the screen
       print $key if length $output > 0;          
       alarm($timeout);     #reset the alarm
           #last if the user hits return
       last if ( $val == 10 || $val == 13);
       # chop one if we get a backspace
       if( $val == 8 ){ chop $output; print " "; print chr(8); }
       }
   }
   ReadMode 0;
   print "\n";
   $output;
}

sub my_alarm{
   print "I just died because you waited too long!\n"; exit;        
}
[download]

This is a simple example for a Tk based Timeout dialog (timeout: 5 seconds):

#script

use strict;
use warnings;

use lib qw(.);
use Data::Dumper;

use TimeOutDialog;

my $x;
TimeOutDialog::ask(\$x);

if ( defined ($x) )
{
    print "*$x*";
}
else
{
    print "timeout\n";
}
[download]

#dialog module



package TimeOutDialog;

use Tk;

sub ask
{
    my $mw = MainWindow->new();

    my $target = shift;

    my $label  = $mw->Label ( -text => "Please anwer my question:" )->
+pack;

    my $text   = $mw->Entry->pack;

    my $button = $mw->Button
    (
        -text    => 'confirm',
        -command => sub
        {
            $$target = $text->get();
            $mw->destroy;
        },
    )->pack;

    my $id = $mw->after
    (
        5000,
        sub
        {
            $$target = undef;
            $mw->destroy;
        }
    );

    MainLoop;
}

1;
[download]



holli, /regexed monk/

this example was just what I needed.

Thanks!!!

print "What is your name Anonymous?\n"; eval { local $SIG{ALRM} = sub { die "Timeout" }; alarm 10; chomp($answer = <STDIN>); alarm 0; }; if ($@ and $@ =~ /Timeout/) { $answer = "Anonymous"; } print "Hello $answer!\n";

perldoc -f select
[download]

Note: select only works with sockets in Windows.