#!/usr/bin/perl -w
#

use strict;
use Fcntl qw( LOCK_SH LOCK_EX LOCK_UN LOCK_NB );

# "./locktest" uses flock(), "./locktest 1" uses fcntl() locks.
use constant FCNTL => 0<@ARGV;

BEGIN {
    if(  ! FCNTL  ) {
        warn "Using flock()...\n";
    } else {
        warn "Using fcntl() locks...\n";
        require Fcntl;
        Fcntl->import( qw(
            F_GETLK F_SETLK F_SETLKW
            F_RDLCK F_UNLCK F_WRLCK
        ) );
        eval 'use subs "flock"';
        { my $f= *flock } # Don't warn about 'flock' only used once.
        *flock= sub {
            my( $fh, $mode )= @_;
            if(  ! ref($fh)  &&  $fh !~ /'|::/  ) {
                $fh= caller() . "::" . $fh;
            }
            my $nb= $mode & LOCK_NB();
            my $lock;
            my $count= 0;
            $count++, $lock= F_RDLCK()   if  $mode & LOCK_SH();
            $count++, $lock= F_WRLCK()   if  $mode & LOCK_EX();
            $count++, $lock= F_UNLCK()   if  $mode & LOCK_UN();
            if(  1 != $count  ) {
                require Carp;
                Carp::croak( "$count of LOCK_SH, LOCK_EX, LOCK_UN set, not 1" )
            }
            # start, len, PID, type, whence:
            my $struct= pack( "LL LL I S S", 0,0, 0,0, 0, $lock, 0 );
            my $op= $nb ? F_SETLK() : F_SETLKW();
            return fcntl( $fh, $op, $struct );
        };
    }
}
open DATA, "+>lock" or warn "Can't open lock file: $!\n";

my %config= ( delay => 5 );

$|++;

flock( \*DATA, LOCK_SH|LOCK_NB )
  or  die "$$ can't lock self: $!\n";
warn "$$ shares.\n";

if(  ! flock( \*DATA, LOCK_EX|LOCK_NB )  ) {
    warn "$$ waiting for previous instance(s) to exit...\n";
    select( undef, undef, undef, rand($config{delay}) );
    my $start= time();
    my $end;
    alarm( 5*$config{delay} );
    my $oldSig= $SIG{ALRM};
    $SIG{ALRM}= sub {
        warn "$$ previous instance(s) still running!\n";
        warn "$$ tho, lock obtained ".localtime($end),$/   if  $end;
        die "$$ ", localtime($start)." .. ".localtime(), $/;
    };
    flock( \*DATA, LOCK_EX );
    warn "$$ owns\n";
    $end= time();
    alarm( 0 );
    $SIG{ALRM}= defined($oldSig) ? $oldSig : 'DEFAULT';
    warn "Running...\n";
}
# Will revert lock to shared below

while (1)
{
    if(  ! flock( \*DATA, LOCK_EX|LOCK_NB )  ) {
        warn "$$ leaving to allow new instance to run.\n";
        exit( 0 );
    }
    warn "$$ owns\n";
    sleep( 1 );
    flock( \*DATA, LOCK_SH|LOCK_NB )
      or  die "$$ can't revert self lock to shared: $!\n";
    warn "$$ shares\n";
    sleep $config{delay};
}
__END__