Perl flock: prevent multiple invocation based on variable

Question

I would like to prevent multiple invocation of a Perl script based on a variable or command-line arguments. Extending this answer:

#!/usr/bin/env perl

use strict;
use warnings;

use Getopt::Long;
my ( $foo, $bar );
GetOptions (
    "foo" => \$foo,
    "bar" => \$bar,
    ) || die "usage: $0 [ -foo | -bar ]\n";

use Fcntl ':flock';
flock(DATA, LOCK_EX|LOCK_NB) or die "There can be only one! [$0]";

say STDOUT (($foo?"foo":$bar?"bar":"nobody")." sleeps");
sleep(2);

# mandatory, flocking depends on DATA file handle
__DATA__

How can I lock app.pl -foo and app.pl -bar independently?

`__DATA__` is a file handle of the perl script you are running - which is the same independent of the command line argument,. If you want different locks depending on the command line argument you have to construct a filename based on the argument, open it to get the file handle and lock this instead of `__DATA__`. — Steffen Ullrich, Sep 11 '22 at 13:33
To use the same mechanism, you would need to lock two different files. But you could use a different mechanism, such as writing the arguments to a file and removing them when the program ends. (But then you have to worry about stale locks.) — ikegami, Sep 11 '22 at 13:36

score 1 · Answer 1 · edited Sep 12 '22 at 05:29

This is what I've come up so far. Kindly suggest if there's a better answer:

#!/usr/bin/env perl

use strict;
use warnings;

$SIG{HUP}=\&sigHandler;  # 1
$SIG{INT}=\&sigHandler;  # 2
$SIG{QUIT}=\&sigHandler; # 3
$SIG{KILL}=\&sigHandler; # 9 - CANNOT BE CAUGHT
$SIG{TERM}=\&sigHandler; # 15
$SIG{STOP}=\&sigHandler; # 17 - CANNOT BE CAUGHT

use Getopt::Long;
my ( $foo, $bar );
GetOptions (
    "foo" => \$foo,
    "bar" => \$bar,
    ) || die "usage: $0 [ -foo | -bar ]\n";


use Fcntl qw(:flock);

sub lock {
    my ($fh) = @_;
    flock($fh, LOCK_EX|LOCK_NB) or die "There can only be one! [$0]: $!\n";
}

sub unlock {
    my ($fh) = @_;
    flock($fh, LOCK_UN) or die "Cannot unlock file - $!\n";
}

my $file = "$ENV{'HOME'}/".($foo?"foo":$bar?"bar":"nobody");
open(my $fh, '>', $file) or die "Can't open $file: $!";

sub sigHandler {
    say STDERR "$0: Program interrupted by '@_'. Terminating...";
    unlink ($file);
    unlock ($fh);
    exit 1;
}

lock ($fh);
say STDOUT (($foo?"foo":$bar?"bar":"nobody")." sleeps");
sleep(5);
unlink ($file);
unlock ($fh);
exit 0;

in your error handler : you should remove the file from disk only if your process holds the lock on it, or not remove the file from disk at all. Otherwise, there is a small time window (from after the `$file = ...` assignment until the return-or-die of the `unlock()` function) during which your program will delete the lockfile on `Ctrl+C` even if it doesn't hold the lock on it. — LeGEC, Sep 12 '22 at 09:33

stevieb · Answer 2 · 2022-09-12T18:03:28.903

I added a singleton() method to IPC::Shareable that does this using shared memory. Here's a simple example. It uses the argument sent into the script as the 'glue' to lock the script run.

use warnings;
use strict;

use IPC::Shareable;

die "Need arg" if ! @ARGV;

my $arg = $ARGV[0];

my $lock = $arg;
my $warn = 1;

IPC::Shareable->singleton($lock, $warn);

for (1..10) {
    print "$_\n";
    sleep 1;
}

Running perl script.pl foo will lock with foo. If you run the command again while the first instance is still running, you'll get Process ID 1105497 exited due to exclusive shared memory collision. If you run it with perl script.pl bar, it'll succeed.

It'd be wise to use a lock glue string more complex than just the argument (perhaps the name of the script concatenated with the argument value), but I digress.

I also wrote Script::Singleton which locks out any second instance of a script from being run, but it's implemented at compile time, so it can't decipher based on argument. It's script-level only.

Perl flock: prevent multiple invocation based on variable

2 Answers2