view release on metacpan or  search on metacpan

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

    return;
}

sub _touch {
  my $file = shift;
  open my $touch, '>>', $file;
  close $touch;
  return;
}

sub _releaseAfterFork {
    my $self = shift;

    # for this implementation, it is more like acquire after fork
    my $label = $$ == $self->{ppid} ? 'P' : 'C';

    my $wait = time + 5.0;

    for my $i (0 .. $self->{count} - 1) {
        if ($self->{initial}[$i] eq $label) {
            my $file = $self->{files}[$i];
            if ($file) {
                my $fh;
                if (!open $fh, '>>', $file) {
                    carp 'FS::Sync::Semaphlock::releaseAfterFork: ',
                         "error acquiring resource $i in $label";
                    next;
                }
                flock $fh, 2;
                $self->{acquired}[$i] = $fh;
            } else {
                carp 'FS::Sync::Semaphlock::releaseAfterFork: ',
                    "no resource $i $file to acquire in $label";
            }
        }
    }
    return;
}

sub release {
    my ($self, $n) = @_;
    return if $n<0 || $n>=$self->{count};
    if (defined $self->{acquired}[$n]) {
        my $z = flock $self->{acquired}[$n], 8;
        $self->{acquired}[$n] = undef;
        return $z;
    }
    return;
}

sub acquire {
    my ($self, $n, $timeout) = @_;
    return if $n<0 || $n>=$self->{count};
    my $file = $self->{files}[$n];
    if (defined $self->{acquired}[$n]) {
        return -1;
    }
    my $fh;

    # on Cygwin, using fcntl to emulate flock, this open can
    # (intermittently) fail with $! := "Device or resource busy"
    for my $try (1..5) {
        last if open $fh, '>>', $file;
        if ($try == 5) {
            carp "failed to acquire file resource $file after 5 tries: $!";
            return;
        }
        Time::HiRes::sleep(0.25 * $try);
    }

    if (defined $timeout) {
        my $expire = Time::HiRes::time() + $timeout;
        my $z;
        do {
            $z = flock $fh, 6;
            if ($z) {
                $self->{acquired}[$n] = $fh;
                return $z;
            }
            if ($timeout > 0.0) {
                Time::HiRes::sleep(0.01);
            }
        } while (Time::HiRes::time() < $expire);
        close $fh;
        return 0;
    }

    # no timeout
    my $z = flock $fh, 2;
    if ($z) {
        $self->{acquired}[$n] = $fh;
    }
    return $z;
}

sub DESTROY {
    my $self = shift;
    $self->release($_) for 0 .. $self->{count}-1;
    $self->{acquired} = [];
    unlink @{$self->{unlink}} if $self->{unlink};
    $self->{files} = [];
}

sub _get_filename {
    no warnings 'once';
    # best if this file is not on an NFS filesystem
    my @dirs;
    if ($^O eq 'MSWin32') {
        @dirs = ('C:/Temp', 'C:/Windows/Temp',
                 'C:/Winnt/Temp', 'D:/Windows/Temp', 'D:/Winnt/Temp',
                 'E:/Windows/Temp', 'E:/Winnt/Temp', $ENV{TEMP}, '.');
    } else {
	my ($cwd) = Forks::Super::Util::abs_path('.');
        @dirs = ('/dev/shm', '/tmp', '/var/tmp', '/usr/tmp', $cwd);
    }
    foreach my $dir (@dirs, $Forks::Super::IPC_DIR) {
        if ($dir =~ /\S/ && -d $dir && -r $dir && -w $dir && -x $dir) {
            return sprintf "%s/_sync%d-%03d",
                           $dir, $Forks::Super::MAIN_PID || $$, $ipc_seq++;
        }
    }