view release on metacpan or  search on metacpan

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

of the last C<check> call. It is metadata and is not, by itself, a
guarantee that the corresponding process currently owns the lock.

After a successful C<lock>, the attribute contains the UID associated
with the newly acquired lock.

In C<flock> mode, the operating system does not provide the UID of the
process holding the system lock. Therefore, when inspecting a foreign
lock, C<uid> represents only the UID recorded in the lock file.

=head2 unlock

    $self = $self->unlock;

This method performs unlocking the lock file and removes it

=head1 HISTORY

See C<Changes> file

=head1 TO DO

See C<TODO> file

=head1 SEE ALSO

L<Lock::File>, L<File::TinyLock>, L<JIP::LockFile>, L<LockFile::Simple>,
L<Acrux::FilePid>

=head1 AUTHOR

Serż Minus (Sergey Lepenkov) L<https://www.serzik.com> E<lt>abalama@cpan.orgE<gt>

=head1 COPYRIGHT

Copyright (C) 1998-2026 D&D Corporation

=head1 LICENSE

This program is distributed under the terms of the Artistic License Version 2.0

See the C<LICENSE> file or L<https://opensource.org/license/artistic-2-0> for details

=cut

use Carp qw/croak/;
use File::Spec;
use File::Basename qw/basename/;
use IO::File;
use Fcntl qw/O_RDWR O_RDONLY O_WRONLY O_CREAT LOCK_EX LOCK_NB LOCK_UN/;
use Cwd qw/getcwd/;

use constant {
        RETRIES     => 5,
        DELAY       => 60,
    };

sub new {
    my $class = shift;
    my $args = @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {};
    my $self  = bless {%$args}, $class;
    $self->{debug}      ||= 0;
    $self->{error}      = "";
    $self->{file}       //= File::Spec->catfile(getcwd, sprintf("%s.lock", basename($0)));
    $self->{pid}        //= $$; # Current PID by default
    $self->{own}        //= 0; # Owner PID
    $self->{uid}        //= 0; # Owner UID
    $self->{auto}       //= 0;
    $self->{retries}    //= RETRIES;
    $self->{delay}      //= DELAY;
    $self->{'flock'}    ||= 0;
    $self->{fh}         = undef;
    $self->{_is_locked} = 0;

    # PID normalize
    my $raw_pid = $self->{pid} || 0;
       $self->{pid} = abs(int($raw_pid)) if defined($raw_pid) && $raw_pid =~ /^-?\d+$/;
    unless (defined($self->{pid}) && $self->{pid} =~ /^[0-9]{1,11}$/) { # Protect
        croak("Incorrect \"pid\" attribute: $raw_pid");
    }

    # Check etries and delay
    croak("Incorrect \"retries\" attribute: " . $self->{retries}) unless $self->{retries} =~ /^[0-9]{1,5}$/;
    croak("Incorrect \"delay\" attribute: " . $self->{delay}) unless $self->{delay} =~ /^[0-9]{1,5}$/;

    # Lock file
    return $self->lock if $self->{auto};
    return $self;
}

sub file { shift->{file} }
sub pid { shift->{pid} }
sub own { # Owner PID
    my $self = shift;
    if (scalar(@_) >= 1) {
        $self->{own} = shift;
        return $self;
    }
    return $self->{own};
}
sub uid { # Owner UID
    my $self = shift;
    if (scalar(@_) >= 1) {
        $self->{uid} = shift;
        return $self;
    }
    return $self->{uid};
}
sub error {
    my $self = shift;
    if (scalar(@_) >= 1) {
        $self->{error} = shift;
        return $self;
    }
    return $self->{error};
}
sub lock {
    my $self = shift;
       $self->error(undef);
    if ($self->_is_locked) {
        $self->_debug(sprintf("File \"%s\" already locked", $self->file));