When the alarm clock goes of unexpectedly.

Recently, I saw someone questioning the need for an alarm 0; after code like

eval {
       alarm 5;
       do_stuff();
       alarm 0;
};

You don't need it under the two obvious code paths (code runs successfully within the time limit and code doesn't finish before the time limit), but if do_stuff(); dies, then you need to disable the alarm (because the alarm 0; in the block eval won't get a chance to run). My solution to this problem is

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

This function takes between two and four arguments. The first two are the number of seconds to wait before timing out and a reference to the code to run respectively. The next argument is a reference to code that should be run in the event that the code times out, and the last is a reference to code that should be run in the event that an error occurs. Here are a few examples of how to call it:

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" };

This is probably reinventing the wheel, but it works for me.

Here is the full code.