view release on metacpan or  search on metacpan

bin/plockf  view on Meta::CPAN

#
# Author: Slaven Rezic
#
# Copyright (C) 2016,2017 Slaven Rezic. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Mail: slaven@rezic.de
# WWW:  http://www.rezic.de/eserte/
#

use strict;
use Errno;
use Fcntl ();
use Getopt::Long;

use vars qw($VERSION);
$VERSION = "0.04";

# sysexits(3) constants
use constant EX_USAGE       => 64;
use constant EX_UNAVAILABLE => 69;
use constant EX_SOFTWARE    => 70;
use constant EX_OSERR       => 71;
use constant EX_CANTCREAT   => 73;
use constant EX_TEMPFAIL    => 75;

sub set_impl ();
sub handle_error ($);
sub progname ();

sub usage (;$) {
    my $msg = shift;
    if ($msg) {
	warn $msg, "\n";
    }
    warn "usage: " . progname . " [-kns] [-t seconds] file command [arguments]\n";
    exit EX_USAGE;
}

my $timeout;
my $keep;
my $silent;
my $nocreat;

Getopt::Long::Configure('require_order');
GetOptions(
	   'help|h|?' => sub { usage },
	   'k'        => \$keep,
	   'n'        => \$nocreat,
	   's'        => \$silent,
	   't=f'      => \$timeout,
	   'v|version'            => sub {
	       print "plockf version $VERSION\n";
	       exit 0;
	   },
	  );

if (defined $timeout && $timeout < 0) {
    usage "Timeout must be positive";
}

my $lock_file = shift
    or usage "Lock file is not specified";
my $cmd = shift
    or usage "Command is not specified";

set_impl;

my $timed_out;
my $alarm;
if (defined $timeout && $timeout > 0) {
    $SIG{ALRM} = sub { $timed_out = 1 };
    if ($timeout !~ m{^\d+$} && eval { require Time::HiRes; Time::HiRes->VERSION(1.9716); Time::HiRes->import('ualarm'); 1 }) { # do we need and can we do floating point timeouts?
	$alarm = \&Time::HiRes::alarm;
    } else {
	if ($timeout < 1) { $timeout = 1 }
	$alarm = sub { alarm($_[0]) };
    }
    $alarm->($timeout);
}

my $lock_fh = acquire_lock(0);
while (!$lock_fh && !$timed_out && (!defined $timeout || $timeout > 0)) {
    if ($^O eq 'MSWin32') {
	# systems where alarm() does not work with blocking syscalls
	wait_for_lock_nonblocking();
	$lock_fh = acquire_lock(0);
    } elsif ($keep) {
	$lock_fh = acquire_lock(1);
    } else {
	wait_for_lock();
	$lock_fh = acquire_lock(0);
    }
}

if ($alarm) {
    $alarm->(0);
}

if (!$lock_fh) {
    handle_error EX_TEMPFAIL;
}

my $do_cleanup = !$keep;

$SIG{TERM} = sub { exit }; # would run END block

system { $cmd } $cmd, @ARGV;
if ($? == -1) {
    warn progname . ": calling '$cmd @ARGV' failed: $!\n";
    exit EX_OSERR;
} elsif ($? & 127) {
    exit EX_SOFTWARE;
} else {
    my $exit_code = $? >> 8;
    exit $exit_code;
}

END {