Create a gist now

Instantly share code, notes, and snippets.

A function to handle timing out
#!/usr/bin/perl
use strict;
use warnings;
sub timeout {
my ($wait, $code, $timedout, $error) = (@_,
sub { warn $@ }, sub { die $@ });
eval {
local $SIG{ALRM} = sub { die "timeout\n" };
alarm $wait;
$code->();
alarm 0;
1;
} or do {
alarm 0; #ensure that alarm is not still set
#raise error if it isn't a timeout
if ($@ eq "timeout\n") {
$timedout->();
} else {
$error->();
}
};
}
timeout 1,
sub { die "oops\n" },
sub { warn "timeout out\n" },
sub { warn "died with $@" };
timeout 1,
sub { select undef, undef, undef, 2 },
sub { warn "timeout out\n" },
sub { warn "died with $@" };
timeout 1,
sub { print "normal execution\n" },
sub { warn "timeout out\n" },
sub { warn "died with $@" };
timeout 1, sub { select undef, undef, undef, 2 };
timeout 1, sub { die "and here it ends" };
print "this is not printed\n";
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment