view release on metacpan or  search on metacpan

lib/Forks/Super/Sync/Win32Mutex.pm  view on Meta::CPAN

package Forks::Super::Sync::Win32Mutex;
use Win32::Mutex;
use Win32::Semaphore;
use Forks::Super::Sync::Semaphlock;
use Carp;
use POSIX ':sys_wait_h';
use strict;
use warnings;

our @ISA = qw(Forks::Super::Sync);
our $VERSION = '0.97';
our $NOWAIT_YIELD_DURATION = 50; # milliseconds

# Something we have to watch out for is a process dying without
# releasing the resources that it possessed. We have three
# defences against this issue below.
#
# 1. call CORE::kill 0, ... to see if other proc is still alive
# 2. check $! to see if/how the  Win32::Mutex::wait  call failed
# 3. release resources in a DESTROY block (and  remove  func, though that
#    probably doesn't help that much)

sub new {
    my ($pkg, $count, @initial) = @_;
    my $self = bless {}, $pkg;
    $self->{count} = $count;
    $self->{initial} = [ @initial ];

    # does creating a unique name help?
    $self->{mutex} = [ map { Win32::Mutex->new(0, "$$-$^T-$_") } 1 .. $count ];
    $self->{invalid} = [ (0) x $count ];

    return $self;
}

sub _releaseAfterFork {
    my ($self, $childPid) = @_;
    $self->{childPid} = $childPid;
    my $label = $self->{label} = $$ == $self->{ppid} ? 'P' : 'C';

    for my $n (0 .. $self->{count} - 1) {
	if ($self->{initial}[$n] eq $label) {
	    $self->acquire($n);
	}
    }
    return;
}

# more robust version of Win32::Mutex->wait.
# detects when partner process has died without releasing the mutex
# return true if successfully waited on lock
sub _wait_on {
    my ($self, $n, $expire) = @_;
    return 1 if !$self->{mutex};
    my $partner = $$ == $self->{ppid} ? $self->{childPid} : $self->{ppid};
    while (1) {
	local $! = 0;
	my $nk = CORE::kill 0, $partner;
	if (!$nk) {
	    carp "sync::_wait_on process $$ thinks $partner is gone [3]";
	    $self->{skip_wait_on} = 1;
	    $_++ for @{$self->{invalid}};
	    # delete $self->{mutex};
	    return $Forks::Super::Sync::SYNC_PARTNER_GONE;
	}

	my $z = $self->{mutex} && 
	    $self->{mutex}[$n]->wait($NOWAIT_YIELD_DURATION);

	if ($z) {
	    return 1;
	}
	# $!{ERROR_BAD_COMMAND} is a Windows thing
	if ($!{EINVAL} || $!{ESRCH} || $!{ERROR_BAD_COMMAND}) {
	    carp "sync::_wait_on: \$!=$!";
	    return 2;
	} 
	elsif ($!) {