#!/usr/bin/perl
$| = 1;
sub
usage(
$x
) {
print
STDERR
q[
tlock [-<option> [parameter]
] <command> [parameter ...]
Locking
with
timeouts.
Options:
-c <c> Use configuration file <c>. The other command line options overrule the
settings in the configuration file.
-d <d> Set
lock
directory to <d>.
-h Show help text.
-m <m> Set marker to <m>. Marker is the prefix that tlock names will have in
the file
system
.
-o <o> Set owner of the tlocks. Is silently ignored
if
the script user does
not have the necessary permissions.
-p <p> Set patience to <p>. Patience is the
time
that tlock will
try
to get a
lock
that is already taken.
-V Show version.
Commands:
tlock take <label> <timeout>
Takes the specified tlock
if
possible. Prints the token value.
tlock renew <label> <token> <timeout>
Renews the tlock, so that it
times
out <timeout> seconds from the call of
this command.
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>
Prints 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(
'hVc:d:m:o:p:'
,
$opt
) or usage(1);
if
(
$opt
->{h}) {
usage(0);
}
elsif
(
$opt
->{V}) {
print
'tlock v'
.
$Sys::Tlock::VERSION
.
"\n"
;
exit
0;
};
usage(1)
if
scalar
@ARGV
== 0;
my
$cmd
=
shift
@ARGV
;
my
%tropt
= ();
$tropt
{conf} =
$opt
->{c}
if
exists
$opt
->{c};
$tropt
{dir} =
$opt
->{d}
if
exists
$opt
->{d};
$tropt
{marker} =
$opt
->{m}
if
exists
$opt
->{m};
$tropt
{owner} =
$opt
->{o}
if
exists
$opt
->{o};
$tropt
{patience} =
$opt
->{p}
if
exists
$opt
->{p};
if
(
$cmd
eq
'take'
) {
usage(1)
if
scalar
@ARGV
< 2;
usage(1)
if
scalar
@ARGV
> 3;
tlock_take(
@ARGV
,
%tropt
) ||
exit
1;
print
$_
.
"\n"
;
}
elsif
(
$cmd
eq
'renew'
) {
usage(1)
if
scalar
@ARGV
!= 3;
tlock_renew(
@ARGV
,
%tropt
) ||
exit
1;
}
elsif
(
$cmd
eq
'release'
) {
usage(1)
if
scalar
@ARGV
!= 2;
tlock_release(
@ARGV
,
%tropt
) ||
exit
1;
}
elsif
(
$cmd
eq
'alive'
) {
usage(1)
if
scalar
@ARGV
!= 2;
tlock_alive(
@ARGV
,
%tropt
) ||
exit
1;
}
elsif
(
$cmd
eq
'taken'
) {
usage(1)
if
scalar
@ARGV
!= 1;
tlock_taken(
@ARGV
,
%tropt
) ||
exit
1;
}
elsif
(
$cmd
eq
'expiry'
) {
usage(1)
if
scalar
@ARGV
!= 1;
my
$expiry
= tlock_expiry(
@ARGV
,
%tropt
);
exit
1
if
not
defined
$expiry
;
print
$expiry
.
"\n"
;
}
elsif
(
$cmd
eq
'zing'
) {
usage(1)
if
scalar
@ARGV
!= 0;
tlock_zing(
%tropt
);
}
else
{
usage(1);
};
exit
0;