package Mutexlock; # -*- Perl -*-

use POSIX;

my($lastfile, $lasterror);

sub lock {
    my($type, $file) = @_;
    my($self, $fd);
    local(*FILE);

    $lastfile = $file;
    $self = {};
    $self->{file} = $file;
    $self->{pid} = $$;
    $fd = POSIX::open($file, O_CREAT|O_EXCL|O_WRONLY, 0600);
    if ( !defined $fd ) {
	$lasterror = "open: $!";
	return undef;
    }
    unless ( open(FILE, ">&=$fd") ) {
	# unlikely
	$lasterror = "Couldn't fdopen";
	POSIX::close($fd);
	return undef;
    }
    print FILE "$self->{pid}\n";
    unless ( close(FILE) ) {
	$lasterror = "close: $!";
	return undef;
    }
    bless $self, $type;
}

sub new {
    my($type, $file) = @_;
    my($self);

    $self = lock Mutexlock $file;
    return undef unless $self;
    $self->{OK} = 1;
    $self;
}

sub LastError {
    my($pid);
    local(*FILE);

    if ( $lasterror eq "open: File exists" ) {
	unless ( open(FILE, $lastfile) ) {
	    return "open: $!";
	}
	$pid = <FILE>;
	unless ( defined $pid && $pid =~ /^\d+$/ ) {
	    return "bad lockfile";
	}
	chomp($pid);
	close(FILE);
	if ( kill 0, $pid ) {
	    return "$pid is already running";
	}
	else {
	    return "crashed process $pid";
	}
    }
    $lasterror;
}

# beware of forked DESTROY methods. check pids.
sub DESTROY {
    my($self) = shift;

    if ( exists $self->{OK} && $self->{pid} == $$ ) {
	unlink($self->{file}) or die("unlink $self->{file}: $!\n");
    }
}

sub unlock {
    my($self) = shift;

    $self->{OK} = 1;
}

1;