Perl Read and Write Lock

Question

I am looking for a good way to implement read / write locks in Perl. This is necessary to synchronize access to files from different threads and / or Perl processes on Windows and Unix. Tried Fcntl :: flock, which would be ideal for me if it worked as expected. Unfortunately, it seems that under stress, flock allows you to lock an already locked file in another thread. I looked at some CPAN modules, but most of them are implemented using a flock. Then I plan to evaluate fcntl for Unix and Win32 :: Mutex for Windows. This seems like a fairly common task, and maybe I am missing a simple solution. If you know about anyone, could you please point it to me?

Thank!

Answer 1

flock will not do what you want streaming.

You can implement your own lock using sysopen , which fails if the file exists when used with O_EXCL|O_CREAT.

Example: child processes competing for a lock

use warnings;
use strict;
use feature 'say';
use Fcntl;
use Time::HiRes qw(sleep);

my $lock_file = ".lock.$$";
sub get_lock {
    my ($file, $pid) = @_; 
    my $fh;
    while (not sysopen $fh, $file, O_WRONLY|O_EXCL|O_CREAT) {
        say "\t($$: lock-file exists ..)";
        sleep 0.5;
    }   
    say $fh $pid;
}
sub release_lock {
    my ($file, $pid) = @_; 
    unlink $file or die "Error unliking $file: $!";
    say "\t($$: released lock)";
}

my @pids;
for (1..4) {
    my $pid = fork // die "Can't fork: $!";
    if ($pid == 0) {
        sleep rand 1;
        get_lock($lock_file, $$);
        say "$$, locked and processing";
        sleep rand 1;
        release_lock($lock_file, $$);
        say "$$ completed.";
        exit
    }   
    push @pids, $pid;    
}
wait for @pids;

It is better to use File :: Temp for the name of the lock file, but read the docs carefully.

Three-Process Output Example

3659, locked and processing
        (3660: lock-file exists ..)
        (3658: lock-file exists ..)
        (3659: released lock)
3659 completed.
3660, locked and processing
        (3658: lock-file exists ..)
        (3658: lock-file exists ..)
        (3660: released lock)
3660 completed.
3658, locked and processing
        (3658: released lock)
3658 completed.

---

O_EXCL NFS: 2.6 NFSv3 . , link(2) . . man 2 open ( , sysopen open syscall).

---

,

sub open_with_lock {
    my ($file, $mode) = @_; 
    get_lock($lock_file, $$);
    open my $fh, $mode, $file or die "Can't open $file: $!";
    return $fh;
}

sub close_and_release {
    my ($fh) = @_; 
    close $fh;
    release_lock($lock_file, $$);
    return 1;
}

get_lock release_lock, , .

# use statements as above
use Path::Tiny;           # only to show the file

my $lock_file = ".lock.file.access.$$"; 
my $file = 't_LOCK.txt';    
my @pids;
for (1..4) 
{
    my $pid = fork // die "Can't fork: $!";

    if ($pid == 0) {
        sleep rand 1;
        my $fh = open_with_lock($file, '>>');
        say "$$ (#$_) opening $file ..";
        say $fh "this is $$ (#$_)";
        sleep rand 1;
        close_and_release($fh);
        say "$$ (#$_) closed $file.";
        say '---';
        exit;
    }   
    push @pids, $pid;
}
wait for @pids;

print path($file)->slurp;
unlink $file;

use

        (18956: "lock"-file exists ..)    # print out of order
18954 (#1) opening t_LOCK.txt ...
        (18955: "lock"-file exists ..)
        (18956: "lock"-file exists ..)
        (18955: "lock"-file exists ..)
        (18954: released lock)
18954 (#1) closed t_LOCK.txt.
---
18956 (#3) opening t_LOCK.txt ...
        (18955: "lock"-file exists ..)
        (18956: released lock)
18956 (#3) closed t_LOCK.txt.
---
18955 (#2) opening t_LOCK.txt ...
        (18955: released lock)
18955 (#2) closed t_LOCK.txt.
---
this is 18954 (#1)
this is 18956 (#3)
this is 18955 (#2)

( , STDOUT)