How to implement file locking in Perl

Introduction

The serialization of read/write access should be used to prevent file corruption which might be caused by a concurrent write operation. Furthermore, it should also be prevented that we read the file until all current changes made by concurrent processes are completed.

The function flock can be used to implemented the functionality.

In this blog post I will provide a couple of code examples for the use cases that are missing in the original documentation.

Lock with wait

In the first example we will try to acquire a lock and wait until we get it. We’ll run the same program concurrently in two different sessions and observe the output.

#!/u00/oracle/orabase/local/perl/bin/perl -w
use strict;
use Fcntl qw(:flock );
open my $fh , '>' , '/tmp/test_file' ;
print localtime . ": trying to set lock...\n" ; 
flock( $fh , LOCK_EX) ;
print localtime . ": lock set, sleeping...\n" ; 
sleep 10 ;
flock( $fh , LOCK_UN) ;
print localtime . ": lock removed, sleeping...\n" ; 

The second session waited indeed for the lock until it was released by the first session:

the output of the first process:
Sat Jan 16 08:19:24 2016: trying to set lock...
Sat Jan 16 08:19:24 2016: lock set, sleeping...
Sat Jan 16 08:19:34 2016: lock removed, sleeping...
the output of the second process:
Sat Jan 16 08:19:26 2016: trying to set lock...
Sat Jan 16 08:19:34 2016: lock set, sleeping...
Sat Jan 16 08:19:44 2016: lock removed, sleeping...

In the second example we will explore what happens if the lock holder ends before releasing the lock:

#!/u00/oracle/orabase/local/perl/bin/perl -w
use strict;
use Fcntl qw(:flock );
open my $fh , '>' , '/tmp/test_file' ;
print localtime . ": trying to set lock...\n" ; 
flock( $fh , LOCK_EX) ;
print localtime . ": lock set, sleeping...\n" ; 
sleep 10 ;
print localtime . ": exiting...\n" ;

As expected, the lock gets released when the process stops:

the output of the first process
Sat Jan 16 08:05:06 2016: trying to set lock...
Sat Jan 16 08:05:06 2016: lock set, sleeping...
Sat Jan 16 08:05:16 2016: exiting...
the output of the second process
Sat Jan 16 08:05:08 2016: trying to set lock...
Sat Jan 16 08:05:16 2016: lock set, sleeping...
Sat Jan 16 08:05:26 2016: exiting...

Lock without wait

Finally, we’ll acquire the lock but this time won’t be waiting for the lock if it cannot be acquired. This is accomplished by applying the bitwise OR on the operation parameter (LOCK_EX | LOCK_NB) of the function flock.

#!/u00/oracle/orabase/local/perl/bin/perl -w
use strict;
use Fcntl qw(:flock );
open my $fh , '>' , '/tmp/test_file' ;
print localtime . ": trying to set lock...\n" ; 
my $succeeded = flock( $fh , LOCK_EX | LOCK_NB ) ;
if ( $succeeded ) {
  print localtime . ": lock set, sleeping...\n" ;  
} else {
  print localtime . ": couldn't acquire lock, sleeping...\n" ;
}
sleep 10 ;
flock( $fh , LOCK_UN) ;
print localtime . ": lock removed, sleeping...\n" ; 
the output of the first process
Sat Jan 16 08:27:52 2016: trying to set lock...
Sat Jan 16 08:27:52 2016: lock set, sleeping...
Sat Jan 16 08:28:02 2016: lock removed, sleeping...
the output of the second process
Sat Jan 16 08:27:53 2016: trying to set lock...
Sat Jan 16 08:27:53 2016: couldn't acquire lock, sleeping...
Sat Jan 16 08:28:03 2016: lock removed, sleeping...
Thanks for sharing

Nenad Noveljic

Leave a Reply

Your email address will not be published. Required fields are marked *

This site uses Akismet to reduce spam. Learn how your comment data is processed.