Chris Rodriguez wrote:
>
> Hi all,
> Thanks very much to everyone for this list-serve, and especially to Rob
> and Bill for helping me so much with this. I'm basically using Bill's
> code (below) and I have it doing what I want. So yay, mission
> accomplished, basically, but two peculiar glitches gum things up and
> slow me down. I'd like to ask about those as it would be sweet to get
> around them.
> I have to repeatedly check a bunch of scripts for the possibility they
> may have infinite loops. I occasionally get an error message reading:
> Win32::Process::Create infinite2.pl : at Bills_code.pl: line 46.
I don't - what are the conditions when this happens ?
> That refers to the line in the code that's similar to the message
> itself. Win32::Process… etc.
What's the exact message ? I added $^E in code below which may help.
> A second issue is that this all runs many thousand times slower than it
> used to.
There is another delay on the wait that will cause the output to delay
more for each script started. I lowered it from 200 to 10 below.
This version will start as many finishing or non-finishing scripts as
you like and let you know what happened.
use strict;
use warnings;
use Win32::Process;
my $Perl = $^X;
my $timeout = 10 * 1000; # timeout after 10 seconds
my $wait_delay = 10; # msecs to wait for each child wait
my $num_children = 32; # total children
my $fraction_to_hang = .5; # percetage of children to hang
my $tmp = $ENV{TMP} || $ENV{TEMP} || 'C:/tmp' || 'C:/temp';
open OUT, ">$tmp/foo1"; close OUT; # empty log files
open OUT, ">$tmp/foo2"; close OUT; # empty log files
my @children = ();
# you could make this a hash and store more than the object (script name
# and pid for example)
for (1 .. $num_children) { # start n children scripts
# just use two scripts - 1 exits and the other hangs
# infinite1.pl finishes in 4-5 seconds; infinite2.pl hangs
my $num = 1; $num = 2 if $_ > int ($num_children * $fraction_to_hang);
my $script = "infinite$num.pl";
print "Starting script $_ using $script ";
my $obj = run_process ($script, $_);
my $pid = $obj->GetProcessID();
print "pid=$pid\n";
push @children, $obj;
}
my $start = Win32::GetTickCount(); # start timer
# check for children still running or timeout
my $finished = 0;
my $killed = 0;
my $kill_failed = 0;
while (1) {
# do for each child
my $num_left = 0;
for (my $ii = 0; $ii < @children; ++$ii) {
my $obj = $children[$ii];
next if $obj == 0;
++$num_left;
# reap any finished children
my $res = $obj->Wait($wait_delay); # wait for child
if ($res == 1) {
++$finished;
$children[$ii] = 0;
my $pid = $obj->GetProcessID();
print "Reaped $pid\n";
}
}
last if not $num_left; # none running if 0
# check for timeout
my $diff = Win32::GetTickCount() - $start;
print "num_left=$num_left, diff=$diff\n";
last if $diff > $timeout; # timeout after n seconds
sleep 1; # give up some CPU
}
print "kill remaining scripts if any\n";
foreach my $obj (@children) { # kill any scripts still running
next if $obj == 0;
my $pid = $obj->GetProcessID();
my $exit = 0;
if (Win32::Process::KillProcess($pid, $exit)) {
++$killed;
} else {
warn "Kill failed for $pid";
++$kill_failed;
}
print "kill $pid ($exit)\n";
}
printf "%3u scripts finished OK\n", $finished;
printf "%3u scripts were killed\n", $killed;
printf "%3u scripts failed to be killed\n", $kill_failed;
exit 0;
sub run_process {
my $script = shift;
my $copy_num = shift;
my $pobj;
Win32::Process::Create($pobj, $Perl, "perl $script $copy_num", 0,
DETACHED_PROCESS, '.') or die "Win32::Process::Create $script: $!($^E)";
return $pobj;
}
__END__
infinite1.pl:
#!perl --
use strict;
use warnings;
my $copy = shift || 0;
my $tmp = $ENV{TMP} || $ENV{TEMP} || 'C:/tmp' || 'C:/temp';
open OUT, ">>$tmp/foo1";
binmode OUT; select ((select (OUT), $| = 1)[0]);
for (1 .. 2000) {
print OUT "$copy: $0\n";
sleep 2;
}
close OUT;
__END__
infinite2.pl:
#!perl --
use strict;
use warnings;
my $copy = shift || 0;
my $tmp = $ENV{TMP} || $ENV{TEMP} || 'C:/tmp' || 'C:/temp';
open OUT, ">>$tmp/foo2";
binmode OUT; select ((select (OUT), $| = 1)[0]);
for (1 .. 2000) {
print OUT "$copy: $0\n";
sleep 2;
}
close OUT;
__END__
_______________________________________________
Perl-Win32-Users mailing list
Perl-Win32-Users@listserv.ActiveState.com
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
