show lock holder information in errstr

lib/File/NFSLock.pm

@@ -161,11 +161,12 @@ sub new {
     ### If lock exists and is readable, see who is mooching on the lock
 
     my $fh;
+    my @them = ();
+
     if ( -e $self->{lock_file} &&
          open ($fh,'+<', $self->{lock_file}) ){
 
       my @mine = ();
-      my @them = ();
       my @dead = ();
 
       my $has_lock_exclusive = !((stat _)[2] & $SHARE_BIT);
@@ -239,7 +240,8 @@ sub new {
     ### If non-blocking, then kick out now.
     ### ($errstr might already be set to the reason.)
     if ($self->{lock_type} & LOCK_NB) {
-      $errstr ||= "NONBLOCKING lock failed!";
+      $errstr ||= "NONBLOCKING lock failed - holder(s) " . join( ',', @them );
+      $errstr =~ s/\n//gms;
       return undef;
     }
 
@@ -248,7 +250,8 @@ sub new {
 
     ### but don't wait past the time out
     if( $quit_time && (time > $quit_time) ){
-      $errstr = "Timed out waiting for blocking lock";
+      $errstr ||= "Timed out waiting for blocking lock - holder(s) " . join( ',', @them );
+      $errstr =~ s/\n//gms;
       return undef;
     }
 

t/120_single_errstr.t

@@ -0,0 +1,55 @@
+# tests for errstr contents on failure to acquire lock
+
+use strict;
+use warnings;
+
+use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX LOCK_NB );
+use File::NFSLock;
+use File::Temp qw(tempfile);
+use IO::Handle;
+use Test::More tests => 8;
+
+my $datafile = (tempfile 'XXXXXXXXXX', 'TMPDIR' => 1)[1];
+my $lockfile = $datafile . $File::NFSLock::LOCK_EXTENSION;
+
+# Create a blank file
+sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC );
+close ($fh);
+ok(-e $datafile && !-s _, 'create target file');
+note( 'datafile >' . $datafile . '<' );
+note( 'lockfile >' . $lockfile . '<' );
+# Wipe any old stale locks
+unlink $lockfile;
+
+# using fork() only to coordinate the test, validation of
+# locks in parent/child across fork is done in other tests
+my $pid = fork();
+
+if ($pid) {
+    # i'm the parent, wait for child to create the lock
+    STDOUT->autoflush( 1 );
+    ok( $pid > 0, 'fork successful' );
+    # wait for child to create the lock
+    while (! -f $lockfile) {
+        sleep( 1 );
+    }
+    ok( -f $lockfile, 'child acquired lock' );
+    my $blocking_lock = File::NFSLock->new( $datafile, LOCK_EX, 1 );
+    ok( ! defined( $blocking_lock ), 'parent unable to acquire blocking lock' );
+    like( $File::NFSLock::errstr, qr/$pid/, 'errstr contains lock holder pid' );
+    note( 'errstr >' . $File::NFSLock::errstr . '<' );
+    my $non_blocking_lock = File::NFSLock->new( $datafile, LOCK_EX | LOCK_NB, 1 );
+    ok( ! defined( $non_blocking_lock ), 'parent unable to acquire non-blocking lock' );
+    like( $File::NFSLock::errstr, qr/$pid/, 'errstr contains lock holder pid' );
+    note( 'errstr >' . $File::NFSLock::errstr . '<' );
+    ok( kill( 'TERM', $pid ), 'kill child' );
+}
+else {
+    # i'm the child, create the lock and wait for parent to kill me
+    my $lock = File::NFSLock->new( $datafile, LOCK_EX | LOCK_NB );
+    sleep;
+}
+
+# Wipe the temporary and lock files;
+unlink $datafile;
+unlink $lockfile;