use v5.12; use warnings; #use Data::Dump; use Fcntl qw(:flock); use Time::HiRes qw/time sleep/; $|=1; my $lock_path = "./LOCK_DEMO"; my $wait = 10; # ------- traditional way test for existence say "First One !?!" if ! -e $lock_path; # NB: This fails sometimes because of race condition # ------ Open open my $fh, ">", $lock_path or die "Can't open $lock_path: $!"; # ------ Lock File say "Wait for Access"; flock($fh, LOCK_EX) or die "Cannot lock $lock_path - $!"; # ------ Unrivaled Actions say "There can be only one HIGHLANDER!"; for (1..$wait) { say $_; sleep 1; } say "I'm done"; # ------ Release Lock say "Un-Locking"; flock($fh, LOCK_UN) or die "Cannot unlock $lock_path - $!"; # ============ The last one has to switch off the light # ------ allow concurrent lock sleep 0.01; # ----- Test Non-Blocking Lock say "Try Lock without waiting"; my $can_lock = flock($fh, LOCK_EX | LOCK_NB); # ------ Close close $fh; # ----- Last script cleans up LOCK-File for next demo if ($can_lock) { say "LAST ONE!!!"; say "delete $lock_path"; unlink $lock_path or die "Cannot delete $lock_path - $!"; } else { say "not last one" } # ----- Keep cmd window open for a while for (1..20) { print "."; sleep 1; } #### > start perl demo_lock.pl & start perl demo_lock.pl & start perl demo_lock.pl & perl demo_lock.pl