#!/usr/bin/perl
use strict;
use warnings;
use v5.10;
use Fcntl qw( LOCK_EX LOCK_UN );
use autodie qw( open flock close );
sub main
{
# create a tempfile
open my $h,'>>','tempfile.tmp';
close $h;
# start a background process that locks the tempfile for 10 seconds
if ($^O eq 'MSWin32') {
system 1,$^X,$0,'locker';
} else {
my $pid=fork() // die "Can't fork: $!";
unless ($pid) {
exec $^X,$0,'locker' or die "Can't exec: $!";
}
}
sleep 1; # wait one second for the helper process;
open $h,'>>','tempfile.tmp';
$@='';
my $start=time();
eval {
local $SIG{'ALRM'}=sub { die "timeout" };
say 'main: alarm 5';
alarm(5);
say 'main: flock LOCK_EX';
flock($h,LOCK_EX);
say 'main: alarm 0';
alarm(0);
};
my $err=$@ || 'successfully locked';
my $stop=time();
say "main: $err";
say 'main: ',$stop-$start,' seconds have passed';
close $h;
# allow locker() to finish before returning to command prompt
($^O eq 'MSWin32') ? sleep 1 : wait;
}
sub locker
{
open my $h,'>>','tempfile.tmp';
say 'locker: flock LOCK_EX';
flock($h,LOCK_EX);
say 'locker: locked';
say 'locker: sleep 10';
sleep 10;
say 'locker: flock LOCK_UN';
flock($h,LOCK_UN);
say 'locker: unlocked';
close $h;
}
@ARGV ? locker() : main();
####
>perl lockdemo.pl
locker: flock LOCK_EX
locker: locked
locker: sleep 10
main: alarm 5
main: flock LOCK_EX
main: timeout at lockdemo.pl line 30.
main: 5 seconds have passed
locker: flock LOCK_UN
locker: unlocked
>
##
##
H:\tmp>perl lockdemo.pl
locker: flock LOCK_EX
locker: locked
locker: sleep 10
main: alarm 5
main: flock LOCK_EX
locker: flock LOCK_UN
main: alarm 0
main: successfully locked
main: 10 seconds have passed
locker: unlocked
H:\tmp>