#!/usr/bin/perl
# tlock
# Locking with timeouts.
# (c) 2022-2023 Bjrn Hee
# Licensed under the Apache License, version 2.0
# https://www.apache.org/licenses/LICENSE-2.0.txt

use strict;
use experimental qw(signatures);
$| = 1;

use Sys::Tlock;
use Getopt::Std qw(getopts);

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub usage( $x ) { print STDERR q[

tlock [-<option> [parameter]] <command> [parameter ...]

Locking with timeouts.

Options:

-d <d>  Set the lock directory to <d>.
-h      Show help text.
-m <m>  Set marker to <m>. Marker is the prefix tlock names will have in the
        file system.
-p <p>  Set patience to <p>. Patience is the time that tlock will try to get a
        lock that is already taken.
-V      Show the version.

Commands:

tlock take <label> <timeout> [<patience>]
    Takes the specified tlock if possible. Returns the token value.

tlock renew <label> <token> <timeout>
    Renews the tlock.

tlock release <label> <token>
    Releases the tlock.

tlock alive <label> <token>
    Returns true if the specified tlock is still alive.

tlock taken <label>
    Returns true if any tlock with the given label, is alive.

tlock expiry <label>
    Returns the time when the tlock with the given label will expire.

tlock zing
    Cleans up the lock directory.

] =~ s/^\s+/\n/r =~ s/\s+$/\n\n/r ; exit $x;};
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #

my $opt = {};
getopts('hVd:m:p:',$opt) or usage(1);

if ($opt->{h}) {
    usage(0);
    }
elsif ($opt->{V}) {
    print 'tlock v'.$Sys::Tlock::VERSION."\n";
    exit 0;
    };

if (exists $opt->{d}) {
    die 'The lock directory "'.$opt->{d}.'" not found.' if not -d $opt->{d};
    $Sys::Tlock::dir = $opt->{d};
    };
if (exists $opt->{m}) {
    die 'Bad first character in marker.' if $opt->{m} !~ m/^[a-zA-Z]/;
    die 'Bad last character in marker.' if $opt->{m} !~ m/[a-zA-Z0-9]$/;
    die 'Bad character in marker.' if $opt->{m} =~ m/[^a-zA-Z0-9\-\_]/;
    $Sys::Tlock::marker = $opt->{m};
    };
if (exists $opt->{p}) {
    die 'Patience set to bad value "'.$opt->{p}.'".' if $opt->{p} !~ m/^\d+(?:\.\d+)?$/;
    die 'Patience set to bad value "0".' if $opt->{p} == 0;
    $Sys::Tlock::patience = $opt->{p};
    };

usage(1) if scalar @ARGV == 0;
my $cmd = shift @ARGV;

if ($cmd eq 'take') {
    usage(1) if scalar @ARGV < 2;
    usage(1) if scalar @ARGV > 3;
    tlock_take(@ARGV) || exit 1;
    print $_."\n";
    }
elsif ($cmd eq 'renew') {
    usage(1) if scalar @ARGV != 3;
    tlock_renew(@ARGV) || exit 1;
    }
elsif ($cmd eq 'release') {
    usage(1) if scalar @ARGV != 2;
    tlock_release(@ARGV) || exit 1;
    }
elsif ($cmd eq 'alive') {
    usage(1) if scalar @ARGV != 2;
    tlock_alive(@ARGV) || exit 1;
    }
elsif ($cmd eq 'taken') {
    usage(1) if scalar @ARGV != 1;
    tlock_taken(@ARGV) || exit 1;
    }
elsif ($cmd eq 'expiry') {
    usage(1) if scalar @ARGV != 1;
    my $expiry = tlock_expiry(@ARGV);
    exit 1 if not defined $expiry;
    print $expiry."\n";
    }
elsif ($cmd eq 'zing') {
    usage(1) if scalar @ARGV != 0;
    tlock_zing;
    }
else {
    usage(1);
    };

exit 0; # ------------------------------------------------------------------- #

__END__

