So I've been trying to get threads working in a CGI script I'm writing. The gist of it is I'm making concurrent requests that have a time limit. If any of the requests takes too long I kill them and just use the data from the threads that finished.
The issue is on a Windows box using IIS. The CGI will complete then IIS throws a 'The remote procedure call failed and did not execute' error. Every other call to the script will succeed but the odd one will fail with that error. I would try fork, alert or LWP's timeout feature but the requests are over https and there are well known and documented issues with these other methods on Windows.
I'm using ActiveState Perl 5.8.8, threads 1.71 and XP sp2 w/various updates. Below is a minimal script that will reproduce the error. Any insight would be appreciated. Thanks.
#!/c/Perl/bin/perl
use strict;
use warnings;
use threads;
$|=1;
local $SIG{'KILL'} = sub {
threads->detach() if not threads->is_detached();
threads->exit();
};
sub main {
hook();
print "Done with first call\n";
hook();
print "Done with second call\n";
}
sub hook {
my $hooks = [
{ name => 'one', call => \&func1 },
{ name => 'two', call => \&func2 },
{ name => 'three', call => \&func3 },
];
my $timelimit = 4;
my ($call, $module, $addon, @threads);
foreach my $i ( 0 .. $#{@$hooks} ) {
my $name = $hooks->[$i]{'name'};
my $call = $hooks->[$i]{'call'};
eval {
push @threads, {
call => $name,
func => threads->create({ 'exit' => 'thread_only' }, sub { $call->() }),
};
};
print $@ if $@;
}
my %out;
my $now = time;
while( scalar keys %out != scalar @threads ) {
foreach my $i ( 0 .. $#threads ) {
next if defined $out{$i};
if( ref $threads[$i]->{'func'} eq 'threads' ) {
next unless $threads[$i]->{'func'}->is_joinable;
$out{$i} = $threads[$i]->{'func'}->join;
}
else {
$out{$i} = $threads[$i]->{'func'};
}
$out{$i} = (ref $threads[$i]->{'func'} eq 'threads' ? '[thread ' : '[') .
$threads[$i]->{'call'} . ' '. (time - $now) .' sec]'.
$out{$i} .'[/'. $threads[$i]->{'call'} .']';
}
last if (time - $now) > $timelimit;
select(undef, undef, undef, 0.5); # Alarm-friendly sleep for one half second
}
kill_loose_threads() if threads->tid == 0;
print (join '', @out{sort keys %out});
print "\nTotal time: " . (time - $now) . "\n";
}
sub kill_loose_threads {
foreach my $thread ( threads->list ) {
$thread->kill('KILL')->detach;
}
}
sub func1 { sleep 1; return "I slept 1 second"; }
sub func2 { sleep 3; return "I slept 3 seconds"; }
sub func3 { sleep 8; return "I slept 8 seconds"; }
main();
