How do I implement a trap routine that will fire off a minute later?
I want a perl script that will prompt the user for input, and if the user has not responded to the prompt in a minute, an alarm routine will trigger and exit the script.
Any tips will be greatly appreciated!
You answered your own question :)
an alarm routine will trigger and exit the script
"The first rule of Perl club is you do not talk about
Perl club."
-- Chip Salzenberg
#!/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;
}
If you want to use an event loop system, like Tk, Gtk2, or POE, you can do a neater job. Tk or Gtk2 make it trivial, but you need to be running under X or Windows. You just setup an event to be fired after the timeout you give.
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";
}
#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;
perlmonks.org content © perlmonks.org and davorg, holli, ikegami, redss, salva, sporty, zentara
prlmnks.org © 2006 edmund von der burg (eccles & toad)
v 0.03