#! /usr/bin/perl
use lib '/usr/lib/perl'; use INN::Config;
##
##  Perl module for wrapping the shlock program shipped with INN.
##  Originally written by Julien Élie in 2011 from existing code duplicated
##  and used by several INN programs.
##
##  Various bug fixes, code and documentation improvements since then
##  in 2012, 2021-2024.
##
package INN::Utils::Shlock;

use strict;
use warnings;
use Exporter;

our @ISA = qw(Exporter);
our $VERSION = "$INN::Config::VERSION";

my %lockfiles;

##
##  Returns true if the file is properly locked.
##
sub lock {
    my $lockfile = shift;
    my $lockretrymax = shift;
    my $lockwait = shift;
    my $locktry = 0;

    $lockretrymax = 1 if not defined $lockretrymax;
    $lockwait = 2 if not defined $lockwait;

    while ($locktry < $lockretrymax) {
        if (
            system(
                "$INN::Config::newsbin/shlock", '-p', $$, '-f', $lockfile,
            ) == 0
        ) {
            $lockfiles{$lockfile} = 1;
            return 1;
        }
        $locktry++;
        sleep $lockwait;
    }

    # Failed to lock.
    return 0;
}

##
##  Returns true if the file is properly unlocked.
##
sub unlock {
    my $lockfile = shift;
    if (unlink $lockfile) {
        delete $lockfiles{$lockfile};
        return 1;
    } else {
        return 0;
    }
}

##
##  Attempts to unlock any leftover locks.
##  Returns the number of removed locks.
##
sub releaselocks {
    my $count = 0;

    foreach my $key (keys(%lockfiles)) {
        $count += unlock($key);
    }

    undef(%lockfiles);
    return $count;
}

##  This array will contain what it is possible to export.
our @EXPORT_OK = qw(lock unlock releaselocks);

##  That's all.
1;

__END__

=encoding utf-8

=head1 NAME

INN::Utils::Shlock - Wrapper around the shlock program

=head1 DESCRIPTION

This Perl module wraps the shlock(8) program so that it can easily be used.
Calling B<shlock> is more portable than using flock(2) and its corresponding
Perl function because this function does not work as expected on all
existing systems.

See the shlock(8) documentation for more information.

Using INN::Utils::Shlock is straight-forward:

    use lib '<pathnews>/lib/perl';
    use INN::Utils::Shlock;

    my $lockfile = "myprogram.LOCK";

    # Acquire a lock.
    INN::Utils::Shlock::lock($lockfile);

    # Do whatever you want.  The lock prevents concurrent accesses.

    # Unlock.
    INN::Utils::Shlock::unlock($lockfile);

These two functions return C<1> on success, C<0> on failure.  For example,
the success of (un)locking can be checked as:

    INN::Utils::Shlock::lock($lockfile)
        or die "cannot create lock file";

or:

    if (! INN::Utils::Shlock::lock($lockfile, 4)) {
        die "giving up after 4 attempts to create lock file";
    }

Instead of calling C<< unlock(I<lockfile>) >>, the C<releaselocks()>
function can be called.  It removes any leftover locks, which is useful
when several different locks are used.  Another possible use is to call
it in an END code block:

    END {
        # In case we bail out, while holding a lock.
        INN::Utils::Shlock::releaselocks();
    }

=head1 INTERFACE

=over 4

=item lock(I<lockfile>)

Tries to create a lock file named I<lockfile>.

This function returns C<1> on success, C<0> on failure.

=item lock(I<lockfile>, I<tries>)

Tries to create a lock file named I<lockfile>.  If it fails, locking
attempts are repeated once every 2 seconds for at most I<tries> times
(including the first unsuccessful attempt).

This function returns C<1> on success, C<0> on failure.

=item lock(I<lockfile>, I<tries>, I<delay>)

Tries to create a lock file named F<lockfile>.  If it fails, locking
attempts are repeated once every I<delay> seconds for at most I<tries>
times (including the first unsuccessful attempt).

Note that C<< lock(I<lockfile>) >> is equivalent to C<< lock(I<lockfile>,
1, 2) >>.

This function returns C<1> on success, C<0> on failure.

=item releaselocks()

Removes all the lock files previously created by calling the C<<
lock(I<lockfile>) >> function.

This function returns the number of removed lock files.

=item unlock(I<lockfile>)

Removes the file named I<lockfile>.

This function returns C<1> on success, C<0> on failure.

=back

=head1 HISTORY

Documentation and Perl module written by Julien Élie for InterNetNews.

=head1 SEE ALSO

perl(1), shlock(8).

=cut
