#!/usr/bin/perl use strict; use warnings; use IO::File; use Fcntl qw(:flock); our $lock_file = 'test_lck'; # Get rid of our garbage END { unlink ($lock_file, $lock_file . '.A', $lock_file . '.B'); }; our %fh; my $id = 'A'; my $pid; my $buf = 'nothing'; $|++; # Spawn one helpful kid... while (($pid = fork()) == -1) { sleep 2; } unless ($pid) { # This is our child ++ $id; END {}; my $fh = new IO::File "$lock_file.$id", "+>" or die "Failed to open $lock_file.$id: $!\n"; print "$id: about to lock...\n"; unless (flock($fh, LOCK_EX | LOCK_NB)) { die "$id: Failed to acquire lock: $!\n"; } print "$id: done\n"; $fh->syswrite("$id\n", 10); $fh->seek(0, 0); sleep 3; $fh->sysread($buf, 10); chomp $buf; print "$id: got <$buf>\n"; flock($fh, LOCK_UN); $fh->close; exit 0; } my $fh = new IO::File "$lock_file.$id", "+>" or die "Failed to open $lock_file.$id: $!\n"; sleep 1; print "$id: about to lock...\n"; unless (flock($fh, LOCK_EX | LOCK_NB)) { die "$id: Failed to acquire lock: $!\n"; } print "$id: done\n"; $fh->syswrite("$id\n", 10); $fh->seek(0, 0); $fh->sysread($buf, 10); sleep 2; chomp $buf; print "$id: got <$buf>\n"; flock($fh, LOCK_UN); $fh->close; wait(); # Collect our child status exit 0;