view release on metacpan or  search on metacpan

lib/Fugu/Pidfile.pm  view on Meta::CPAN

# $self->acquire($pid):
#	Write the PID and keep the locked handle open. The lock lives
#	until the object is destroyed, or until the process exits. A
#	second acquire on
#	the same file, from any process, fails while the first holds
#	it. The method returns 1, or undef with ->error set.
sub acquire ( $self, $pid = $$ )
{
	if ( $self->{fh} ) {
		$self->{error} = "already acquired $self->{path}";
		return;
	}

	my $fh = $self->_open_locked(1) or return;

	unless ( $self->_store( $fh, $pid ) ) {
		close $fh;
		return;
	}

	$self->{fh} = $fh;

	return 1;
}

# $self->read_pid:
#	Read the PID from the file. The method returns the PID, or
#	undef when the file is absent or holds no decimal PID.
sub read_pid ($self)
{
	open my $fh, '<', $self->{path} or do {
		$self->{error} = "open $self->{path}: $!";
		return;
	};
	my $line = <$fh>;
	close $fh;

	return unless defined $line;
	chomp $line;
	return unless $line =~ /^\d+$/;

	return $line;
}

# $self->remove:
#	Remove the PID file. The method returns 1 when the file is
#	absent afterwards.
sub remove ($self)
{
	return 1 unless -e $self->{path};
	unless ( unlink $self->{path} ) {
		$self->{error} = "unlink $self->{path}: $!";
		return;
	}

	return 1;
}

# $self->is_running:
#	Return the PID from the file when that process is alive.
#	Otherwise return undef.
sub is_running ($self)
{
	my $pid = $self->read_pid;
	return unless defined $pid;
	return unless Fugu::Process->is_alive($pid);

	return $pid;
}

# $self->is_stale:
#	Report if the file names a process that is not alive now. An
#	absent PID file is not stale.
sub is_stale ($self)
{
	my $pid = $self->read_pid;
	return 0 unless defined $pid;

	return !Fugu::Process->is_alive($pid);
}

# $self->_open_locked($nonblocking):
#	Open the file for read and write, create it when it is absent,
#	and take the exclusive lock. The open must not truncate. A
#	truncate before the lock lets a concurrent reader see an empty
#	file.
sub _open_locked ( $self, $nonblocking )
{
	sysopen my $fh, $self->{path}, O_CREAT | O_RDWR, 0644 or do {
		$self->{error} = "open $self->{path}: $!";
		return;
	};

	my $how = $nonblocking ? LOCK_EX | LOCK_NB : LOCK_EX;
	unless ( flock $fh, $how ) {
		$self->{error} = "lock $self->{path}: $!";
		close $fh;
		return;
	}

	return $fh;
}

# $self->_store($fh, $pid):
#	Truncate the locked handle and write the PID. The write is a
#	syswrite, so the bytes reach the file with no flush.
sub _store ( $self, $fh, $pid )
{
	unless ( truncate $fh, 0 ) {
		$self->{error} = "truncate $self->{path}: $!";
		return;
	}
	unless ( defined sysseek( $fh, 0, SEEK_SET ) ) {
		$self->{error} = "seek $self->{path}: $!";
		return;
	}

	my $data    = "$pid\n";
	my $written = syswrite $fh, $data;
	unless ( defined $written && $written == length $data ) {
		$self->{error} = "write $self->{path}: $!";
		return;
	}

	return 1;
}

1;