> I'm trying to get some synchronisation working between several child
> processes, using a counting semaphore.
> Probably I'm doing something wrong, because I get errors when releasing the
> semaphore, stating that the handle is invalid.
> Because the release works the first time, I think I must do something with
> the inherited filehandles.
There are several problems with Win32::Semaphore and fork()ed
threads. And a few with your code.
1) The docs say that open() is a CLASS method, not an instance one.
And that is gives you an object as its return value.
So you should use it like this :
$semchild = Win32::Semaphore->open($name)
or die "Cannot open semaphore $!";
So you should create the semaphore in the parent thread and then
create new objects with Win32::Semaphore->open($name) in the
children. AND DO NOT USE THE OBJECT CREATED IN THE PARENT FROM THE
CHILDREN.
Also for whatever reason the ->release() did not like $prev preset to
999. Leave it undefined.
2) Since the parent wait()s for the semaphore it should also
release() it. Otherwise you run out of semaphores pretty quickly.
3) You have to make sure your children will not call DESTROY() on the
semaphore object you created in the parent. It would then become
unusable even in the main thread !!!
The DESTROY() calles some Win32 API functions and of course since all
threads have the same Win32 API handle in the $sem object, it doesn't
matter which one calls the DESTROY().
Of course you can't
undef $sem;
in the children since that would call the DESTROY().
You have to do it like this :
bless $sem, "EmptyObjectNotDefinedAnywhere";
undef $sem;
The first line unties the object from the Win32::Semaphore class so
the second may safely delete the perl part of it.
I'm sure you will need this hack in many other places with many other
object as well with fork()ed threads. Actualy you should do this each
time you create an object BEFORE fork(), but cannot allow more
threads to be able to actualy destroy the object.
The reason is that the perl part of the object was cloned (every
child has its own copy) but the external part (something the system
or the DLL keeps and you only point to it with a handle or pointer)
was NOT. So even if it might be safe to use the object it is NOT SAFE
TO DESTROY it.
The code should look something like this :
use Win32::Semaphore;
$sem = Win32::Semaphore->new($initial,$maximum,$name);
for (my $i = 1; $i < 25; $i++) {
$sem->wait();
if (fork()) {
#child
bless $sem, "EmptyObjectNotDefinedAnywhere";
undef $sem;
$semchild = Win32::Semaphore->open($name) or die "Cannot open
semaphore $!";
$semchild->wait(500) or die "Child $$ : Wait failed\n";
... do something
$semchild->release();
exit;
} else {
#parent
$sem->release();
}
}
Jenda
P.S.: Fixed version of your code is attached. Actualy I'd like to thank you. I
did not notice this module could be used so easily to restrict the number of
running children alive at a time.
P.P.S.: (for Sarathy) I believe some note about the DESTROY() problem and
possible solution should be part of perlfork(). I don't know how to write it so
that it's understandable.
== [EMAIL PROTECTED] == http://Jenda.Krynicky.cz ==
: What do people think?
What, do people think? :-)
-- Larry Wall in <[EMAIL PROTECTED]>
use strict;
use Win32::Semaphore;
use vars qw($sem $semchild);
$SIG{CHLD} = sub {wait()};
sub test_sem();
exit test_sem();
#package EmptyClass;
#package main;
sub test_sem() {
my ($pid, $initial, $maximum, $name, $wksta) = (0,5,5,'SEINPAAL','');
my ($sec,$min,$hour);
# Create counting semaphore for a maximum of 5 outstanding childs
# each child decrements count with 1 at exit, enabling parent to spawn another
$sem = Win32::Semaphore->new($initial,$maximum,$name);
for (my $i = 1; $i < 25; $i++) {
$sem->wait(); #wait for semaphore to become available
print "Spawning child for $i\n";
$pid = fork;
if ($pid == 0 ) { # Child
bless $sem, "EmptyClass";
die "cannot fork: $!" unless defined $pid;
$semchild = Win32::Semaphore->open($name) or die "Cannot open semaphore
$!";
$semchild->wait(500) or die "Child $$ : Wait failed\n";
($sec,$min,$hour,) = localtime(time);
print sprintf("Child %d starts on %02i:%02i:%02i\n",$$, $hour, $min,
$sec);
for (my $j = 0; $j < 100000; $j++) {
# Do some work
my $k = $j / 2
}
($sec,$min,$hour,) = localtime(time);
print sprintf("Child %d ends on %02i:%02i:%02i\n",$$, $hour, $min,
$sec);
my ($inc, $prev) = (1);
# $semchild->release() or die "Could not release semaphore : $^E";
$semchild->release($inc,$prev) or die "Child $$ could not release
semaphore : $^E";
print "Child $$ released on $prev\n";
exit;
} else {
my ($inc, $prev) = (1);
$sem->release($inc,$prev) or die "Father could not release semaphore :
$^E";
}
}
}
