2008-03-28
Perl goodies: Executing perl code in your Perl script with timeout
Here is the scenario: You are implementing a program that requires scripting. Since you already know Perl, you decide you program needs to execute Perl code. Here is a short recipe you can follow, that also include a little time out checking.
1 #!/usr/bin/perl
2
3 use strict;
4
5 my $code = "my \$wait = int(rand(20)+1); print \"Sleep time: \$wait\\n\"; print \"Params: \"; print \">\$_ \" foreach \@params; print \"\\n\"; sleep( \$wait );";
6 print "Code to run: $code\n\n";
7
8 $SIG{ALRM} = sub { die "timeout" };
9
10 eval {
11
12 alarm(10);
13 # long-time operations here
14 RunCode( "a", 1 );
15 print "Success\n";
16 alarm(0);
17
18 };
19
20 if ($@) {
21
22 if ($@ =~ /timeout/) {
23
24 # timed out; do what you will here
25 print "Operation timed out\n";
26
27 } else {
28
29 alarm(0); # clear the still-pending alarm
30 die; # propagate unexpected exception
31
32 }
33
34 }
35
36 sub RunCode {
37
38 my @params = @_;
39 my $tmpcode = $code;
40 my $srccode = "";
41 $srccode = sub { eval $tmpcode };
42
43 eval {
44
45 no strict 'refs';
46 my $execresult = $srccode->( @params );
47 if( $@ ) {
48
49 # General error
50 print "RunCode(): error executing script: $@\n\n";
51
52 }
53
54 };
55
56 return;
57
58 }
