view release on metacpan or  search on metacpan

lib/Acrux/FileLock.pm  view on Meta::CPAN

        exit;
    };

    # Using flock
    if ($self->_use_flock) {
        # Initialize or reuse initialized fh
        $self->{fh} //= IO::File->new($self->file, O_RDWR | O_CREAT);
        if (my $fh = $self->{fh}) {
            unless (flock $fh, LOCK_EX | LOCK_NB) {
                $self->error(sprintf("Can't lock \"%s\": %s", $self->file, $!));
                $self->_debug($self->error);
                $self->{fh} = undef;
                return $self;
            }

            # Truncate file
            unless (truncate $fh, 0) {
                $self->error(sprintf("Can't truncate \"%s\": %s", $self->file, $!));
                $self->_debug($self->error);
                return $self->_rollback;
            }
            seek $fh, 0, 0;

            # Write data
            unless ($fh->printf("%d:%d\n", $self->pid || $$, $>)) {
                $self->error(sprintf("Can't write message to \"%s\": %s", $self->file, $!));
                $self->_debug($self->error);
                return $self->_rollback;
            }

            # Ok
            $self->{_is_locked} = 1;
            $self->own($self->pid || $$)->uid($>);
            $self->_debug("Got lock file (flock=true)");
        } else {
            $self->error(sprintf("Can't open \"%s\": %s", $self->file, $!));
            $self->_debug($self->error);
        }
        return $self;
    }

    # Regular case: save temp file first
    my $tmp_file = sprintf("%s.%d", $self->file, $self->pid);
    if (my $fh = IO::File->new($tmp_file, O_WRONLY | O_CREAT)) {
        unless ($fh->printf("%d:%d\n", $self->pid || $$, $>)) {
            $self->error(sprintf("Can't write message to \"%s\": %s", $tmp_file, $!));
            $self->_debug($self->error);
            unlink $tmp_file if -f $tmp_file;
            return $self;
        }
        unless ($fh->close) {
            $self->error(sprintf("Can't close \"%s\": %s", $tmp_file, $!));
            $self->_debug($self->error);
            unlink $tmp_file if -f $tmp_file;
            return $self;
        }

        # Rename temp file to lock file
        for my $try (0 .. $self->{retries}) {
            unless ($self->check()) { # not exists, ok
                if (rename($tmp_file, $self->file)) {
                    $self->{_is_locked} = 1;
                    $self->_debug("Got lock file (flock=false)");
                    return $self;
                }
            }
            if ($self->{retries} && ($try != $self->{retries})) {
                $self->_debug(sprintf("Retrying in %d seconds", $self->{delay}));
                sleep $self->{delay} unless ($try == $self->{retries});
            }
        }
    } else {
        $self->error(sprintf("Can't open \"%s\": %s", $tmp_file, $!));
        $self->_debug($self->error);
    }

    # Remove temp file in silent mode
    unlink $tmp_file if -f $tmp_file;

    # Ok
    return $self;
}
sub check {
    my $self = shift;
       $self->error(undef);

    # Read owner-data of existed file (see own and uid accessors)
    $self->_read_owner;

    return $self->_is_locked
        if $self->_use_flock;

    # File not exists. Returns 0
    return 0 unless -f $self->file;

    # Check current PID and owner PID
    if ($self->own == $self->pid) {
        $self->_debug(sprintf("An attempt to call the check method twice was detected for PID=%d", $self->own));
        return 1;
    }

    # Check owner PID
    if ($self->own && kill(0, $self->own)) {
        # Oops! Process already exists
        $self->_debug(sprintf("Found valid existing lock file for PID=%d", $self->own));
        return 1;
    }

    # Process for owner PID not exists. Check owner UID
    else {
        # Owner UID is current user?
        if ($self->uid && $self->uid != $>) {
            $self->_debug("The owner of the lock file owns NOT current user");
            # Check process by by /proc/PID (for linux only!)
            if (-d File::Spec->catfile("/proc", $self->own)) {
                $self->_debug(sprintf("Found valid existing lock file for PID=%d (by /proc/%d)", $self->own, $self->own));
                return 1;
            }
        }

        # Try unlink the not my lock file