[libfile-nfslock-perl] 06/25: Imported Upstream version 1.21
dom at earth.li
dom at earth.li
Sat Oct 4 21:56:31 UTC 2014
This is an automated email from the git hooks/post-receive script.
dom pushed a commit to branch master
in repository libfile-nfslock-perl.
commit 7f49415a9a344abb2bc4691abae2bffde127a5af
Author: Dominic Hargreaves <dom at earth.li>
Date: Sat Aug 6 15:29:39 2011 +0100
Imported Upstream version 1.21
---
Changes | 14 ++++++++
File-NFSLock.spec | 2 +-
MANIFEST | 1 +
META.yml | 10 ++++++
README | 5 ---
lib/File/NFSLock.pm | 86 ++++++++++++++++++++++++-------------------------
t/100_load.t | 19 +++--------
t/110_compare.t | 16 ++++------
t/120_single.t | 29 +++++++----------
t/200_bl_ex.t | 34 ++++++++++++--------
t/210_nb_ex.t | 59 ++++++++++++++++++----------------
t/220_ex_scope.t | 85 ++++++++++++++++++++++++++++---------------------
t/230_double.t | 29 +++++++++--------
t/240_fork.t | 9 +++---
t/300_bl_sh.t | 92 +++++++++++++++++++++++++++++------------------------
t/400_kill.t | 60 ++++++++++++++++++----------------
t/410_die.t | 60 ++++++++++++++++++----------------
t/420_crash.t | 60 ++++++++++++++++++----------------
18 files changed, 358 insertions(+), 312 deletions(-)
diff --git a/Changes b/Changes
index 9d18164..5f0a954 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,19 @@
Revision history for Perl extension File::NFSLock.
+1.21 Jul 13 17:00 2011
+ - Various patches by Chorny at cpan dot org
+ and fREW frioux at gmail dot com:
+ - Windows NTFS compatibility fixes.
+ - Allow PID to be negative.
+ - Lexically scope temp file handles to
+ reduce changes of memory leak and
+ avoid unintentional glob clobberation.
+ - Security fix: 3 arg open().
+ - Repair test suites logics.
+ - Fixed infinite freezing on Strawberry Perl v5.10.0.
+ - Fixed infinite freezing on ActiveState Perl v5.12.1.
+ - Sorry for the past 8 years of suffering.
+
1.20 May 13 12:00 2003
- Avoid double reverting signal handlers when
unlock() is explicitly called instead of
diff --git a/File-NFSLock.spec b/File-NFSLock.spec
index 44e1c30..abcf4c9 100644
--- a/File-NFSLock.spec
+++ b/File-NFSLock.spec
@@ -1,7 +1,7 @@
# Automatically generated by File-NFSLock.spec.PL
%define class File
%define subclass NFSLock
-%define version 1.20
+%define version 1.21
%define release 1
%define defperlver 5.6.1
diff --git a/MANIFEST b/MANIFEST
index cb44dc5..f3f5ba4 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -18,3 +18,4 @@ t/300_bl_sh.t
t/400_kill.t
t/410_die.t
t/420_crash.t
+META.yml Module meta-data (added by MakeMaker)
diff --git a/META.yml b/META.yml
new file mode 100644
index 0000000..56ad097
--- /dev/null
+++ b/META.yml
@@ -0,0 +1,10 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: File-NFSLock
+version: 1.21
+version_from: lib/File/NFSLock.pm
+installdirs: site
+requires:
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.30
diff --git a/README b/README
index b684529..64001a1 100644
--- a/README
+++ b/README
@@ -123,7 +123,6 @@ METHODS
some methods may be used for additional functionality.
unlock
-
$lock->unlock;
This method may be used to explicitly release a lock that is
@@ -132,7 +131,6 @@ METHODS
scope it is in.
uncache
-
$lock->uncache;
$lock->uncache("otherfile1");
uncache("otherfile2");
@@ -144,7 +142,6 @@ METHODS
as a stand alone subroutine.
newpid
-
my $pid = fork;
if (defined $pid) {
# Fork Failed
@@ -179,14 +176,12 @@ BUGS
Notify paul at seamons.com or bbb at cpan.org if you spot anything.
FIFO
-
Locks are not necessarily obtained on a first come first serve
basis. Not only does this not seem fair to new processes trying to
obtain a lock, but it may cause a process starvation condition on
heavily locked files.
DIRECTORIES
-
Locks cannot be obtained on directory nodes, nor can a directory
node be uncached with the uncache routine because hard links do not
work with directory nodes. Some other algorithm might be used to
diff --git a/lib/File/NFSLock.pm b/lib/File/NFSLock.pm
index cc5604d..9dea38a 100644
--- a/lib/File/NFSLock.pm
+++ b/lib/File/NFSLock.pm
@@ -25,25 +25,25 @@
package File::NFSLock;
use strict;
-use Exporter ();
-use vars qw(@ISA @EXPORT_OK $VERSION $TYPES
- $LOCK_EXTENSION $SHARE_BIT $HOSTNAME $errstr
- $graceful_sig @CATCH_SIGS);
-use Carp qw(croak confess);
+use warnings;
- at ISA = qw(Exporter);
- at EXPORT_OK = qw(uncache);
+use Carp qw(croak confess);
+our $errstr;
+use base 'Exporter';
+our @EXPORT_OK = qw(uncache);
-$VERSION = '1.20';
+our $VERSION = '1.21';
#Get constants, but without the bloat of
#use Fcntl qw(LOCK_SH LOCK_EX LOCK_NB);
-sub LOCK_SH {1}
-sub LOCK_EX {2}
-sub LOCK_NB {4}
+use constant {
+ LOCK_SH => 1,
+ LOCK_EX => 2,
+ LOCK_NB => 4,
+};
### Convert lock_type to a number
-$TYPES = {
+our $TYPES = {
BLOCKING => LOCK_EX,
BL => LOCK_EX,
EXCLUSIVE => LOCK_EX,
@@ -53,9 +53,9 @@ $TYPES = {
SHARED => LOCK_SH,
SH => LOCK_SH,
};
-$LOCK_EXTENSION = '.NFSLock'; # customizable extension
-$HOSTNAME = undef;
-$SHARE_BIT = 1;
+our $LOCK_EXTENSION = '.NFSLock'; # customizable extension
+our $HOSTNAME = undef;
+our $SHARE_BIT = 1;
###----------------------------------------------------------------###
@@ -66,7 +66,7 @@ my $graceful_sig = sub {
exit;
};
- at CATCH_SIGS = qw(TERM INT);
+our @CATCH_SIGS = qw(TERM INT);
sub new {
$errstr = undef;
@@ -107,7 +107,7 @@ sub new {
### need the hostname
if( !$HOSTNAME ){
require Sys::Hostname;
- $HOSTNAME = &Sys::Hostname::hostname();
+ $HOSTNAME = Sys::Hostname::hostname();
}
### quick usage check
@@ -160,8 +160,9 @@ sub new {
### If lock exists and is readable, see who is mooching on the lock
+ my $fh;
if ( -e $self->{lock_file} &&
- open (_FH,"+<$self->{lock_file}") ){
+ open ($fh,'+<', $self->{lock_file}) ){
my @mine = ();
my @them = ();
@@ -170,8 +171,8 @@ sub new {
my $has_lock_exclusive = !((stat _)[2] & $SHARE_BIT);
my $try_lock_exclusive = !($self->{lock_type} & LOCK_SH);
- while(defined(my $line=<_FH>)){
- if ($line =~ /^$HOSTNAME (\d+) /) {
+ while(defined(my $line=<$fh>)){
+ if ($line =~ /^$HOSTNAME (-?\d+) /) {
my $pid = $1;
if ($pid == $$) { # This is me.
push @mine, $line;
@@ -198,10 +199,10 @@ sub new {
### Rescan in case lock contents were modified between time stale lock
### was discovered and lockfile lock was acquired.
- seek (_FH, 0, 0);
+ seek ($fh, 0, 0);
my $content = '';
- while(defined(my $line=<_FH>)){
- if ($line =~ /^$HOSTNAME (\d+) /) {
+ while(defined(my $line=<$fh>)){
+ if ($line =~ /^$HOSTNAME (-?\d+) /) {
my $pid = $1;
next if (!kill 0, $pid); # Skip dead locks from this host
}
@@ -210,18 +211,18 @@ sub new {
### Save any valid locks or wipe file.
if( length($content) ){
- seek _FH, 0, 0;
- print _FH $content;
- truncate _FH, length($content);
- close _FH;
+ seek $fh, 0, 0;
+ print $fh $content;
+ truncate $fh, length($content);
+ close $fh;
}else{
- close _FH;
+ close $fh;
unlink $self->{lock_file};
}
### No "dead" or stale locks found.
} else {
- close _FH;
+ close $fh;
}
### If attempting to acquire the same type of lock
@@ -308,10 +309,9 @@ sub create_magic ($;$) {
my $self = shift;
my $append_file = shift || $self->{rand_file};
$self->{lock_line} ||= "$HOSTNAME $self->{lock_pid} ".time()." ".int(rand()*10000)."\n";
- local *_FH;
- open (_FH,">>$append_file") or do { $errstr = "Couldn't open \"$append_file\" [$!]"; return undef; };
- print _FH $self->{lock_line};
- close _FH;
+ open (my $fh,'>>', $append_file) or do { $errstr = "Couldn't open \"$append_file\" [$!]"; return undef; };
+ print $fh $self->{lock_line};
+ close $fh;
return 1;
}
@@ -394,8 +394,8 @@ sub do_unlock_shared ($) {
my $lock = new File::NFSLock ($lock_file,LOCK_EX,62,60);
### get the handle on the lock file
- local *_FH;
- if( ! open (_FH,"+<$lock_file") ){
+ my $fh;
+ if( ! open ($fh,'+<', $lock_file) ){
if( ! -e $lock_file ){
return 1;
}else{
@@ -405,21 +405,21 @@ sub do_unlock_shared ($) {
### read existing file
my $content = '';
- while(defined(my $line=<_FH>)){
+ while(defined(my $line=<$fh>)){
next if $line eq $lock_line;
$content .= $line;
}
### other shared locks exist
if( length($content) ){
- seek _FH, 0, 0;
- print _FH $content;
- truncate _FH, length($content);
- close _FH;
+ seek $fh, 0, 0;
+ print $fh $content;
+ truncate $fh, length($content);
+ close $fh;
### only I exist
}else{
- close _FH;
+ close $fh;
unlink $lock_file;
}
@@ -478,8 +478,8 @@ sub newpid {
$self->do_unlock_shared;
# Create signal file to notify parent that
# the lock_line entry has been delegated.
- open (_FH, ">$self->{lock_file}.fork");
- close(_FH);
+ open (my $fh, '>', "$self->{lock_file}.fork");
+ close($fh);
}
}
diff --git a/t/100_load.t b/t/100_load.t
index 1e335e8..8c0ed61 100644
--- a/t/100_load.t
+++ b/t/100_load.t
@@ -2,20 +2,9 @@
# `make test'. After `make install' it should work as `perl test.t'
######################### We start with some black magic to print on failure.
+use strict;
+use warnings;
-use Test;
-BEGIN { plan tests => 1; $loaded = 0}
-END { ok $loaded;}
+use Test::More tests => 1;
-# Just make sure everything compiles
-use File::NFSLock;
-use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_SH LOCK_NB);
-#use POSIX qw(tmpnam);
-
-$loaded = 1;
-
-######################### End of black magic.
-
-# Insert your test code below (better if it prints "ok 13"
-# (correspondingly "not ok 13") depending on the success of chunk 13
-# of the test code):
+use_ok 'File::NFSLock';
diff --git a/t/110_compare.t b/t/110_compare.t
index 17a6393..0661c19 100644
--- a/t/110_compare.t
+++ b/t/110_compare.t
@@ -1,14 +1,12 @@
-use Test;
+use strict;
+use warnings;
+
+use Test::More tests => 3;
use File::NFSLock;
use Fcntl;
-plan tests => 4;
-
-# Everything loaded fine
-ok (1);
-
# Make sure File::NFSLock has the correct
# constants according to Fcntl
-ok (&File::NFSLock::LOCK_SH(),&Fcntl::LOCK_SH());
-ok (&File::NFSLock::LOCK_EX(),&Fcntl::LOCK_EX());
-ok (&File::NFSLock::LOCK_NB(),&Fcntl::LOCK_NB());
+is (&File::NFSLock::LOCK_SH(),&Fcntl::LOCK_SH());
+is (&File::NFSLock::LOCK_EX(),&Fcntl::LOCK_EX());
+is (&File::NFSLock::LOCK_NB(),&Fcntl::LOCK_NB());
diff --git a/t/120_single.t b/t/120_single.t
index 90eb9a8..b3fb2b2 100644
--- a/t/120_single.t
+++ b/t/120_single.t
@@ -1,19 +1,14 @@
# Blocking Exclusive test within a single process (no fork)
-use Test;
+use Test::More tests => 2;
use File::NFSLock;
use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX);
-plan tests => 3;
-
-# Everything loaded fine
-ok (1);
-
my $datafile = "testfile.dat";
# Create a blank file
-sysopen ( FH, $datafile, O_CREAT | O_RDWR | O_TRUNC );
-close (FH);
+sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC );
+close ($fh);
ok (-e $datafile && !-s _);
# Wipe any old stale locks
unlink "$datafile$File::NFSLock::LOCK_EXTENSION";
@@ -26,26 +21,26 @@ for (my $i = 0; $i < $n ; $i++) {
file => $datafile,
lock_type => LOCK_EX,
};
- sysopen(FH, $datafile, O_RDWR);
+ sysopen(my $fh, $datafile, O_RDWR);
# Read the current value
- my $count = <FH>;
+ my $count = <$fh>;
# Increment it
$count ++;
# And put it back
- seek (FH,0,0);
- print FH "$count\n";
- close FH;
+ seek ($fh,0,0);
+ print $fh "$count\n";
+ close $fh;
}
# Load up whatever the file says now
-sysopen(FH, $datafile, O_RDONLY);
-$_ = <FH>;
-close FH;
+sysopen($fh, $datafile, O_RDONLY);
+$_ = <$fh>;
+close $fh;
chomp;
# It should be the same as the number of times it looped
-ok $n, $_;
+is $n, $_;
# Wipe the temporary file
unlink $datafile;
diff --git a/t/200_bl_ex.t b/t/200_bl_ex.t
index 70378d9..1160cd6 100644
--- a/t/200_bl_ex.t
+++ b/t/200_bl_ex.t
@@ -1,6 +1,15 @@
# Blocking Exclusive Lock Test
-use Test;
+use strict;
+use warnings;
+
+use Test::More;
+if( $^O eq 'MSWin32' ) {
+ plan skip_all => 'Tests fail on Win32 due to forking';
+}
+else {
+ plan tests => 20+2;
+}
use File::NFSLock;
use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX);
@@ -9,13 +18,12 @@ my $m = 20;
my $n = 50;
$| = 1; # Buffer must be autoflushed because of fork() below.
-plan tests => ($m+2);
my $datafile = "testfile.dat";
# Create a blank file
-sysopen ( FH, $datafile, O_CREAT | O_RDWR | O_TRUNC );
-close (FH);
+sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC );
+close ($fh);
ok (-e $datafile && !-s _);
for (my $i = 0; $i < $m ; $i++) {
@@ -27,15 +35,15 @@ for (my $i = 0; $i < $m ; $i++) {
file => $datafile,
lock_type => LOCK_EX,
};
- sysopen(FH, $datafile, O_RDWR);
+ sysopen(my $fh, $datafile, O_RDWR);
# Read the current value
- my $count = <FH>;
+ my $count = <$fh>;
# Increment it
$count ++;
# And put it back
- seek (FH,0,0);
- print FH "$count\n";
- close FH;
+ seek ($fh,0,0);
+ print $fh "$count\n";
+ close $fh;
}
exit;
}
@@ -48,12 +56,12 @@ for (my $i = 0; $i < $m ; $i++) {
}
# Load up whatever the file says now
-sysopen(FH, $datafile, O_RDONLY);
-$_ = <FH>;
-close FH;
+sysopen(my $fh2, $datafile, O_RDONLY);
+$_ = <$fh2>;
+close $fh2;
chomp;
# It should be $m processes time $n each
-ok $n*$m, $_;
+is $n*$m, $_;
# Wipe the temporary file
unlink $datafile;
diff --git a/t/210_nb_ex.t b/t/210_nb_ex.t
index 4e8c9bb..55e9fac 100644
--- a/t/210_nb_ex.t
+++ b/t/210_nb_ex.t
@@ -1,72 +1,75 @@
+use strict;
+use warnings;
+
# Non-Blocking Exclusive Lock Test
-use Test;
+use Test::More tests => 8;
use File::NFSLock;
use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX LOCK_NB);
$| = 1; # Buffer must be autoflushed because of fork() below.
-plan tests => 8;
my $datafile = "testfile.dat";
# Create a blank file
-sysopen ( FH, $datafile, O_CREAT | O_RDWR | O_TRUNC );
-close (FH);
+sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC );
+close ($fh);
ok (-e $datafile && !-s _);
-
-ok (pipe(RD1,WR1)); # Connected pipe for child1
+my ($rd1,$wr1);
+ok (pipe($rd1,$wr1)); # Connected pipe for child1
if (!fork) {
# Child #1 process
my $lock = new File::NFSLock {
file => $datafile,
lock_type => LOCK_EX | LOCK_NB,
};
- print WR1 !!$lock; # Send boolean success status down pipe
- close(WR1); # Signal to parent that the Non-Blocking lock is done
- close(RD1);
+ print $wr1 !!$lock; # Send boolean success status down pipe
+ close($wr1); # Signal to parent that the Non-Blocking lock is done
+ close($rd1);
if ($lock) {
sleep 2; # hold the lock for a moment
- sysopen(FH, $datafile, O_RDWR);
+ sysopen(my $fh, $datafile, O_RDWR);
# now put a magic word into the file
- print FH "child1\n";
- close FH;
+ print $fh "child1\n";
+ close $fh;
}
exit;
}
ok 1; # Fork successful
-close (WR1);
+close ($wr1);
# Waiting for child1 to finish its lock status
-my $child1_lock = <RD1>;
-close (RD1);
+my $child1_lock = <$rd1>;
+close ($rd1);
# Report status of the child1_lock.
# It should have been successful
ok ($child1_lock);
-ok (pipe(RD2,WR2)); # Connected pipe for child2
+my ($rd2, $wr2);
+ok (pipe($rd2,$wr2)); # Connected pipe for child2
if (!fork) {
# Child #2 process
my $lock = new File::NFSLock {
file => $datafile,
lock_type => LOCK_EX | LOCK_NB,
};
- print WR2 !!$lock; # Send boolean success status down pipe
- close(WR2); # Signal to parent that the Non-Blocking lock is done
- close(RD2);
+ print $wr2 !!$lock; # Send boolean success status down pipe
+ close($wr2); # Signal to parent that the Non-Blocking lock is done
+ close($rd2);
if ($lock) {
- sysopen(FH, $datafile, O_RDWR);
+ sysopen(my $fh, $datafile, O_RDWR);
# now put a magic word into the file
- print FH "child2\n";
- close FH;
+ print $fh "child2\n";
+ close $fh;
}
exit;
}
ok 1; # Fork successful
-close (WR2);
+close ($wr2);
# Waiting for child2 to finish its lock status
-my $child2_lock = <RD2>;
-close (RD2);
+my $child2_lock = <$rd2>;
+close ($rd2);
# Report status of the child2_lock.
# This lock should not have been obtained since
# the child1 lock should still have been established.
@@ -76,9 +79,9 @@ ok (!$child2_lock);
wait; wait;
# Load up whatever the file says now
-sysopen(FH, $datafile, O_RDONLY);
-$_ = <FH>;
-close FH;
+sysopen(my $fh2, $datafile, O_RDONLY);
+$_ = <$fh2>;
+close $fh2;
# It should be child1 if it was really nonblocking
# since it got the lock first.
diff --git a/t/220_ex_scope.t b/t/220_ex_scope.t
index 695fec1..43be1c4 100644
--- a/t/220_ex_scope.t
+++ b/t/220_ex_scope.t
@@ -9,101 +9,112 @@
# If a process has some file locked (say exclusively although it doesn't matter) and another process attempts to get a lock, if it fails it deletes the lock file - whether or not the first (locking process) has finished with its lock. This means any subsequent process that comes along that attempts to lock the file succeeds - even if the first process thinks it still has a lock.
#
-use Test;
+use strict;
+use warnings;
+
+use Test::More;
+if( $^O eq 'MSWin32' ) {
+ plan skip_all => 'Tests fail on Win32 due to forking';
+}
+else {
+ plan tests => 11;
+}
use File::NFSLock;
use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX LOCK_NB);
$| = 1; # Buffer must be autoflushed because of fork() below.
-plan tests => 11;
my $datafile = "testfile.dat";
# Create a blank file
-sysopen ( FH, $datafile, O_CREAT | O_RDWR | O_TRUNC );
-close (FH);
+sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC );
+close ($fh);
ok (-e $datafile && !-s _);
-ok (pipe(RD1,WR1)); # Connected pipe for child1
+my ($rd1, $wr1);
+ok (pipe($rd1, $wr1)); # Connected pipe for child1
if (!fork) {
# Child #1 process
my $lock = new File::NFSLock {
file => $datafile,
lock_type => LOCK_EX | LOCK_NB,
};
- print WR1 !!$lock; # Send boolean success status down pipe
- close(WR1); # Signal to parent that the Non-Blocking lock is done
- close(RD1);
+ print $wr1 !!$lock; # Send boolean success status down pipe
+ close($wr1); # Signal to parent that the Non-Blocking lock is done
+ close($rd1);
if ($lock) {
sleep 2; # hold the lock for a moment
- sysopen(FH, $datafile, O_RDWR);
+ sysopen(my $fh, $datafile, O_RDWR);
# now put a magic word into the file
- print FH "child1\n";
- close FH;
+ print $fh "child1\n";
+ close $fh;
}
exit;
}
ok 1; # Fork successful
-close (WR1);
+close ($wr1);
# Waiting for child1 to finish its lock status
-my $child1_lock = <RD1>;
-close (RD1);
+my $child1_lock = <$rd1>;
+close ($rd1);
# Report status of the child1_lock.
# It should have been successful
ok ($child1_lock);
-ok (pipe(RD2,WR2)); # Connected pipe for child2
+my ($rd2, $wr2);
+ok (pipe($rd2, $wr2)); # Connected pipe for child2
if (!fork) {
# Child #2 process
my $lock = new File::NFSLock {
file => $datafile,
lock_type => LOCK_EX | LOCK_NB,
};
- print WR2 !!$lock; # Send boolean success status down pipe
- close(WR2); # Signal to parent that the Non-Blocking lock is done
- close(RD2);
+ print $wr2 !!$lock; # Send boolean success status down pipe
+ close($wr2); # Signal to parent that the Non-Blocking lock is done
+ close($rd2);
if ($lock) {
- sysopen(FH, $datafile, O_RDWR);
+ sysopen(my $fh, $datafile, O_RDWR);
# now put a magic word into the file
- print FH "child2\n";
- close FH;
+ print $fh "child2\n";
+ close $fh;
}
exit;
}
ok 1; # Fork successful
-close (WR2);
+close ($wr2);
# Waiting for child2 to finish its lock status
-my $child2_lock = <RD2>;
-close (RD2);
+my $child2_lock = <$rd2>;
+close ($rd2);
# Report status of the child2_lock.
# This lock should not have been obtained since
# the child1 lock should still have been established.
ok (!$child2_lock);
-ok (pipe(RD3,WR3)); # Connected pipe for child3
+my ($rd3, $wr3);
+ok (pipe($rd3, $wr3)); # Connected pipe for child3
if (!fork) {
# Child #3 process
my $lock = new File::NFSLock {
file => $datafile,
lock_type => LOCK_EX | LOCK_NB,
};
- print WR3 !!$lock; # Send boolean success status down pipe
- close(WR3); # Signal to parent that the Non-Blocking lock is done
- close(RD3);
+ print $wr3 !!$lock; # Send boolean success status down pipe
+ close($wr3); # Signal to parent that the Non-Blocking lock is done
+ close($wr3);
if ($lock) {
- sysopen(FH, $datafile, O_RDWR);
+ sysopen(my $fh, $datafile, O_RDWR);
# now put a magic word into the file
- print FH "child3\n";
- close FH;
+ print $fh "child3\n";
+ close $fh;
}
exit;
}
ok 1; # Fork successful
-close (WR3);
+close ($wr3);
# Waiting for child2 to finish its lock status
-my $child3_lock = <RD3>;
-close (RD3);
+my $child3_lock = <$rd3>;
+close ($rd3);
# Report status of the child3_lock.
# This lock should also fail since the child1
# lock should still have been established.
@@ -113,9 +124,9 @@ ok (!$child3_lock);
wait; wait; wait;
# Load up whatever the file says now
-sysopen(FH, $datafile, O_RDONLY);
-$_ = <FH>;
-close FH;
+sysopen(my $fh2, $datafile, O_RDONLY);
+$_ = <$fh2>;
+close $fh2;
# It should be child1 if it was really nonblocking
# since it got the lock first.
diff --git a/t/230_double.t b/t/230_double.t
index 362fe61..42016e1 100644
--- a/t/230_double.t
+++ b/t/230_double.t
@@ -4,12 +4,13 @@
# an exclusive lock multiple times for the same file.
use strict;
-use Test;
+use warnings;
+
+use Test::More tests => 5;
use File::NFSLock;
use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_SH LOCK_NB);
$| = 1;
-plan tests => 5;
my $datafile = "testfile.dat";
@@ -17,8 +18,8 @@ my $datafile = "testfile.dat";
unlink ("$datafile$File::NFSLock::LOCK_EXTENSION");
# Create a blank file
-sysopen ( FH, $datafile, O_CREAT | O_RDWR | O_TRUNC );
-close (FH);
+sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC );
+close ($fh);
ok (-e $datafile && !-s _);
@@ -30,9 +31,9 @@ my $lock1 = new File::NFSLock {
ok ($lock1);
-sysopen(FH, $datafile, O_RDWR | O_APPEND);
-print FH "lock1\n";
-close FH;
+sysopen(my $fh2, $datafile, O_RDWR | O_APPEND);
+print $fh2 "lock1\n";
+close $fh2;
my $lock2 = new File::NFSLock {
file => $datafile,
@@ -42,17 +43,17 @@ my $lock2 = new File::NFSLock {
ok ($lock2);
-sysopen(FH, $datafile, O_RDWR | O_APPEND);
-print FH "lock2\n";
-close FH;
+sysopen(my $fh3, $datafile, O_RDWR | O_APPEND);
+print $fh3 "lock2\n";
+close $fh3;
# Load up whatever the file says now
-sysopen(FH, $datafile, O_RDONLY);
-$_ = <FH>;
+sysopen(my $fh4, $datafile, O_RDONLY);
+$_ = <$fh4>;
ok /lock1/;
-$_ = <FH>;
+$_ = <$fh4>;
ok /lock2/;
-close FH;
+close $fh4;
# Wipe the temporary file
unlink $datafile;
diff --git a/t/240_fork.t b/t/240_fork.t
index 12a9ba1..b0f01ff 100644
--- a/t/240_fork.t
+++ b/t/240_fork.t
@@ -4,12 +4,13 @@
# allow a parent to delegate the lock to its child.
use strict;
-use Test;
+use warnings;
+
+use Test::More tests => 5;
use File::NFSLock;
use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_SH LOCK_NB);
$| = 1; # Buffer must be autoflushed because of fork() below.
-plan tests => 5;
my $datafile = "testfile.dat";
@@ -17,8 +18,8 @@ my $datafile = "testfile.dat";
unlink ("$datafile$File::NFSLock::LOCK_EXTENSION");
# Create a blank file
-sysopen ( FH, $datafile, O_CREAT | O_RDWR | O_TRUNC );
-close (FH);
+sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC );
+close ($fh);
ok (-e $datafile && !-s _);
if (1) {
diff --git a/t/300_bl_sh.t b/t/300_bl_sh.t
index 52c3797..1609cdd 100644
--- a/t/300_bl_sh.t
+++ b/t/300_bl_sh.t
@@ -1,6 +1,14 @@
# Blocking Shared Lock Test
+use strict;
+use warnings;
-use Test;
+use Test::More;
+if( $^O eq 'MSWin32' ) {
+ plan skip_all => 'Tests fail on Win32 due to forking';
+}
+else {
+ plan tests => 13+3*20;
+}
use File::NFSLock;
use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_NB LOCK_SH);
@@ -9,19 +17,18 @@ my $m = 20;
my $shared_delay = 5;
$| = 1; # Buffer must be autoflushed because of fork() below.
-plan tests => (13 + 3*$m);
my $datafile = "testfile.dat";
# Create a blank file
-sysopen ( FH, $datafile, O_CREAT | O_RDWR | O_TRUNC );
-close (FH);
+sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC );
+close ($fh);
# test 1
ok (-e $datafile && !-s _);
-# test 2
-ok (pipe(RD1,WR1)); # Connected pipe for child1
+my ($rd1, $wr1);
+ok (pipe($rd1, $wr1)); # Connected pipe for child1
if (!fork) {
# Child #1 process
# Obtain exclusive lock to block the shared attempt later
@@ -29,32 +36,32 @@ if (!fork) {
file => $datafile,
lock_type => LOCK_EX,
};
- print WR1 !!$lock; # Send boolean success status down pipe
- close(WR1); # Signal to parent that the Blocking lock is done
- close(RD1);
+ print $wr1 !!$lock; # Send boolean success status down pipe
+ close($wr1); # Signal to parent that the Blocking lock is done
+ close($rd1);
if ($lock) {
sleep 2; # hold the lock for a moment
- sysopen(FH, $datafile, O_RDWR | O_TRUNC);
+ sysopen(my $fh, $datafile, O_RDWR | O_TRUNC);
# And then put a magic word into the file
- print FH "exclusive\n";
- close FH;
+ print $fh "exclusive\n";
+ close $fh;
}
exit;
}
# test 3
ok 1; # Fork successful
-close (WR1);
+close ($wr1);
# Waiting for child1 to finish its lock status
-my $child1_lock = <RD1>;
-close (RD1);
+my $child1_lock = <$rd1>;
+close ($rd1);
# Report status of the child1_lock.
# It should have been successful
# test 4
ok ($child1_lock);
-# test 5
-ok (pipe(RD2,WR2)); # Connected pipe for child2
+my ($rd2, $wr2);
+ok (pipe($rd2, $wr2)); # Connected pipe for child2
if (!fork) {
# This should block until the exclusive lock is done
my $lock = new File::NFSLock {
@@ -62,11 +69,11 @@ if (!fork) {
lock_type => LOCK_SH,
};
if ($lock) {
- sysopen(FH, $datafile, O_RDWR | O_TRUNC);
+ sysopen(my $fh, $datafile, O_RDWR | O_TRUNC);
# Immediately put the magic word into the file
- print FH "shared\n";
- truncate (FH, tell FH);
- close FH;
+ print $fh "shared\n";
+ truncate ($fh, tell $fh);
+ close $fh;
# Normally shared locks never modify the contents because
# of the race condition. (The last one to write wins.)
# But in this case, the parent will wait until the lock
@@ -76,9 +83,9 @@ if (!fork) {
# This is also a good test to make sure that other shared
# locks can still be obtained simultaneously.
}
- print WR2 !!$lock; # Send boolean success status down pipe
- close(WR2); # Signal to parent that the Blocking lock is done
- close(RD2);
+ print $wr2 !!$lock; # Send boolean success status down pipe
+ close($wr2); # Signal to parent that the Blocking lock is done
+ close($rd2);
# Then hold this shared lock for a moment
# while other shared locks are attempted
sleep($shared_delay*2);
@@ -86,10 +93,10 @@ if (!fork) {
}
# test 6
ok 1; # Fork successful
-close (WR2);
+close ($wr2);
# Waiting for child2 to finish its lock status
-my $child2_lock = <RD2>;
-close (RD2);
+my $child2_lock = <$rd2>;
+close ($rd2);
# Report status of the child2_lock.
# This should have eventually been successful.
# test 7
@@ -110,7 +117,8 @@ $SIG{ALRM} = sub {
# Use pipe to read lock success status from children
# test 8
-ok (pipe(RD3,WR3));
+my ($rd3, $wr3);
+ok (pipe($rd3, $wr3));
# Wait a few seconds less than if all locks were
# aquired asyncronously to ensure that they overlap.
@@ -125,15 +133,15 @@ for (my $i = 0; $i < $m ; $i++) {
lock_type => LOCK_SH,
};
# Send boolean success status down pipe
- print WR3 !!$lock,"\n";
- close(WR3);
+ print $wr3 !!$lock,"\n";
+ close($wr3);
if ($lock) {
sleep $shared_delay; # Hold the shared lock for a moment
# Appending should always be safe across NFS
- sysopen(FH, $datafile, O_RDWR | O_APPEND);
+ sysopen(my $fh, $datafile, O_RDWR | O_APPEND);
# Put one line to signal the lock was successful.
- print FH "1\n";
- close FH;
+ print $fh "1\n";
+ close $fh;
$lock->unlock();
} else {
warn "Lock [$i] failed!";
@@ -143,22 +151,22 @@ for (my $i = 0; $i < $m ; $i++) {
}
# Parent process never writes to pipe
-close(WR3);
+close($wr3);
# There were $m children attempting the shared locks.
for (my $i = 0; $i < $m ; $i++) {
# Report status of each lock attempt.
- my $got_shared_lock = <RD3>;
+ my $got_shared_lock = <$rd3>;
# test 9 .. 8+$m
ok $got_shared_lock;
}
# There should not be anything left in the pipe.
-my $extra = <RD3>;
+my $extra = <$rd3>;
# test 9 + $m
ok !$extra;
-close (RD3);
+close ($rd3);
# If we made it here, then it must have been faster
# than the timeout. So reset the timer.
@@ -176,21 +184,21 @@ for (my $i = 0; $i < $m + 2 ; $i++) {
}
# Load up whatever the file says now
-sysopen(FH, $datafile, O_RDONLY);
+sysopen(my $fh2, $datafile, O_RDONLY);
# The first line should say "shared" if child2 really
# waited for child1's exclusive lock to finish.
-$_ = <FH>;
+$_ = <$fh2>;
# test 13 + 2*$m
ok /shared/;
for (my $i = 0; $i < $m ; $i++) {
- $_ = <FH>;
+ $_ = <$fh2>;
chomp;
# test 14+2*$m .. 13+3*$m
- ok $_, 1;
+ is $_, 1;
}
-close FH;
+close $fh2;
# Wipe the temporary file
unlink $datafile;
diff --git a/t/400_kill.t b/t/400_kill.t
index 3926f2d..66d1502 100644
--- a/t/400_kill.t
+++ b/t/400_kill.t
@@ -1,11 +1,13 @@
# Lock Test with graceful termination (SIGTERM or SIGINT)
-use Test;
+use strict;
+use warnings;
+
+use Test::More tests => 10;
use File::NFSLock;
use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX);
$| = 1; # Buffer must be autoflushed because of fork() below.
-plan tests => 10;
my $datafile = "testfile.dat";
@@ -13,14 +15,15 @@ my $datafile = "testfile.dat";
unlink ("$datafile$File::NFSLock::LOCK_EXTENSION");
# Create a blank file
-sysopen ( FH, $datafile, O_CREAT | O_RDWR | O_TRUNC );
-close (FH);
+sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC );
+close ($fh);
# test 1
ok (-e $datafile && !-s _);
# test 2
-ok (pipe(RD1,WR1)); # Connected pipe for child1
+my ($rd1, $wr1);
+ok (pipe($rd1, $wr1)); # Connected pipe for child1
my $pid = fork;
if (!$pid) {
@@ -31,25 +34,25 @@ if (!$pid) {
lock_type => LOCK_EX,
};
open(STDERR,">/dev/null");
- print WR1 !!$lock; # Send boolean success status down pipe
- close(WR1); # Signal to parent that the Blocking lock is done
- close(RD1);
+ print $wr1 !!$lock; # Send boolean success status down pipe
+ close($wr1); # Signal to parent that the Blocking lock is done
+ close($rd1);
if ($lock) {
sleep 10; # hold the lock for a moment
- sysopen(FH, $datafile, O_RDWR | O_TRUNC);
+ sysopen(my $fh, $datafile, O_RDWR | O_TRUNC);
# And then put a magic word into the file
- print FH "exclusive\n";
- close FH;
+ print $fh "exclusive\n";
+ close $fh;
}
exit;
}
# test 3
ok 1; # Fork successful
-close (WR1);
+close ($wr1);
# Waiting for child1 to finish its lock status
-my $child1_lock = <RD1>;
-close (RD1);
+my $child1_lock = <$rd1>;
+close ($rd1);
# Report status of the child1_lock.
# It should have been successful
# test 4
@@ -64,7 +67,8 @@ ok (kill "INT", $pid);
ok (wait);
# test 7
-ok (pipe(RD2,WR2)); # Connected pipe for child2
+my ($rd2, $wr2);
+ok (pipe($rd2, $wr2)); # Connected pipe for child2
if (!fork) {
# The last lock died, so this should aquire fine.
my $lock = new File::NFSLock {
@@ -73,36 +77,36 @@ if (!fork) {
blocking_timeout => 10,
};
if ($lock) {
- sysopen(FH, $datafile, O_RDWR | O_TRUNC);
+ sysopen(my $fh, $datafile, O_RDWR | O_TRUNC);
# Immediately put the magic word into the file
- print FH "lock2\n";
- truncate (FH, tell FH);
- close FH;
+ print $fh "lock2\n";
+ truncate ($fh, tell $fh);
+ close $fh;
}
- print WR2 !!$lock; # Send boolean success status down pipe
- close(WR2); # Signal to parent that the Blocking lock is done
- close(RD2);
+ print $wr2 !!$lock; # Send boolean success status down pipe
+ close($wr2); # Signal to parent that the Blocking lock is done
+ close($rd2);
exit; # Release this new lock
}
# test 8
ok 1; # Fork successful
-close (WR2);
+close ($wr2);
# Waiting for child2 to finish its lock status
-my $child2_lock = <RD2>;
-close (RD2);
+my $child2_lock = <$rd2>;
+close ($rd2);
# Report status of the child2_lock.
# This should have been successful.
# test 9
ok ($child2_lock);
# Load up whatever the file says now
-sysopen(FH, $datafile, O_RDONLY);
+sysopen(my $fh2, $datafile, O_RDONLY);
-$_ = <FH>;
+$_ = <$fh2>;
# test 10
ok /lock2/;
-close FH;
+close $fh2;
# Wipe the temporary file
unlink $datafile;
diff --git a/t/410_die.t b/t/410_die.t
index f964f5d..abb4e3f 100644
--- a/t/410_die.t
+++ b/t/410_die.t
@@ -1,11 +1,13 @@
# Lock Test with fatal error (die)
-use Test;
+use strict;
+use warnings;
+
+use Test::More tests => 9;
use File::NFSLock;
use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX);
$| = 1; # Buffer must be autoflushed because of fork() below.
-plan tests => 9;
my $datafile = "testfile.dat";
@@ -13,14 +15,15 @@ my $datafile = "testfile.dat";
unlink ("$datafile$File::NFSLock::LOCK_EXTENSION");
# Create a blank file
-sysopen ( FH, $datafile, O_CREAT | O_RDWR | O_TRUNC );
-close (FH);
+sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC );
+close ($fh);
# test 1
ok (-e $datafile && !-s _);
# test 2
-ok (pipe(RD1,WR1)); # Connected pipe for child1
+my ($rd1, $wr1);
+ok (pipe($rd1, $wr1)); # Connected pipe for child1
my $pid = fork;
if (!$pid) {
@@ -30,14 +33,14 @@ if (!$pid) {
file => $datafile,
lock_type => LOCK_EX,
};
- print WR1 !!$lock; # Send boolean success status down pipe
- close(WR1); # Signal to parent that the Blocking lock is done
- close(RD1);
+ print $wr1 !!$lock; # Send boolean success status down pipe
+ close($wr1); # Signal to parent that the Blocking lock is done
+ close($wr1);
if ($lock) {
- sysopen(FH, $datafile, O_RDWR | O_TRUNC);
+ sysopen(my $fh, $datafile, O_RDWR | O_TRUNC);
# And then put a magic word into the file
- print FH "exclusive\n";
- close FH;
+ print $fh "exclusive\n";
+ close $fh;
open(STDERR,">/dev/null");
die "I will die while lock is still aquired";
}
@@ -46,10 +49,10 @@ if (!$pid) {
# test 3
ok 1; # Fork successful
-close (WR1);
+close ($wr1);
# Waiting for child1 to finish its lock status
-my $child1_lock = <RD1>;
-close (RD1);
+my $child1_lock = <$rd1>;
+close ($rd1);
# Report status of the child1_lock.
# It should have been successful
# test 4
@@ -60,7 +63,8 @@ ok ($child1_lock);
ok (wait);
# test 6
-ok (pipe(RD2,WR2)); # Connected pipe for child2
+my ($rd2, $wr2);
+ok (pipe($rd2, $wr2)); # Connected pipe for child2
if (!fork) {
# The last lock died, so this should aquire fine.
my $lock = new File::NFSLock {
@@ -69,36 +73,36 @@ if (!fork) {
blocking_timeout => 10,
};
if ($lock) {
- sysopen(FH, $datafile, O_RDWR | O_TRUNC);
+ sysopen(my $fh, $datafile, O_RDWR | O_TRUNC);
# Immediately put the magic word into the file
- print FH "lock2\n";
- truncate (FH, tell FH);
- close FH;
+ print $fh "lock2\n";
+ truncate ($fh, tell $fh);
+ close $fh;
}
- print WR2 !!$lock; # Send boolean success status down pipe
- close(WR2); # Signal to parent that the Blocking lock is done
- close(RD2);
+ print $wr2 !!$lock; # Send boolean success status down pipe
+ close($wr2); # Signal to parent that the Blocking lock is done
+ close($rd2);
exit; # Release this new lock
}
# test 7
ok 1; # Fork successful
-close (WR2);
+close ($wr2);
# Waiting for child2 to finish its lock status
-my $child2_lock = <RD2>;
-close (RD2);
+my $child2_lock = <$rd2>;
+close ($rd2);
# Report status of the child2_lock.
# This should have been successful.
# test 8
ok ($child2_lock);
# Load up whatever the file says now
-sysopen(FH, $datafile, O_RDONLY);
+sysopen(my $fh2, $datafile, O_RDONLY);
-$_ = <FH>;
+$_ = <$fh2>;
# test 9
ok /lock2/;
-close FH;
+close $fh2;
# Wipe the temporary file
unlink $datafile;
diff --git a/t/420_crash.t b/t/420_crash.t
index 2238f70..9559fb3 100644
--- a/t/420_crash.t
+++ b/t/420_crash.t
@@ -1,11 +1,13 @@
# Lock Test with abnormal or abrupt termination (System crash or SIGKILL)
-use Test;
+use strict;
+use warnings;
+
+use Test::More tests => 10;
use File::NFSLock;
use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX);
$| = 1; # Buffer must be autoflushed because of fork() below.
-plan tests => 10;
my $datafile = "testfile.dat";
@@ -13,14 +15,15 @@ my $datafile = "testfile.dat";
unlink ("$datafile$File::NFSLock::LOCK_EXTENSION");
# Create a blank file
-sysopen ( FH, $datafile, O_CREAT | O_RDWR | O_TRUNC );
-close (FH);
+sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC );
+close ($fh);
# test 1
ok (-e $datafile && !-s _);
# test 2
-ok (pipe(RD1,WR1)); # Connected pipe for child1
+my ($rd1, $wr1);
+ok (pipe($rd1, $wr1)); # Connected pipe for child1
my $pid = fork;
if (!$pid) {
@@ -31,25 +34,25 @@ if (!$pid) {
lock_type => LOCK_EX,
};
open(STDERR,">/dev/null");
- print WR1 !!$lock; # Send boolean success status down pipe
- close(WR1); # Signal to parent that the Blocking lock is done
- close(RD1);
+ print $wr1 !!$lock; # Send boolean success status down pipe
+ close($wr1); # Signal to parent that the Blocking lock is done
+ close($rd1);
if ($lock) {
sleep 10; # hold the lock for a moment
- sysopen(FH, $datafile, O_RDWR | O_TRUNC);
+ sysopen(my $fh, $datafile, O_RDWR | O_TRUNC);
# And then put a magic word into the file
- print FH "exclusive\n";
- close FH;
+ print $fh "exclusive\n";
+ close $fh;
}
exit;
}
# test 3
ok 1; # Fork successful
-close (WR1);
+close ($wr1);
# Waiting for child1 to finish its lock status
-my $child1_lock = <RD1>;
-close (RD1);
+my $child1_lock = <$rd1>;
+close ($rd1);
# Report status of the child1_lock.
# It should have been successful
# test 4
@@ -64,7 +67,8 @@ ok (kill "KILL", $pid);
ok (wait);
# test 7
-ok (pipe(RD2,WR2)); # Connected pipe for child2
+my ($rd2, $wr2);
+ok (pipe($rd2, $wr2)); # Connected pipe for child2
if (!fork) {
# The last lock died, so this should aquire fine.
my $lock = new File::NFSLock {
@@ -73,36 +77,36 @@ if (!fork) {
blocking_timeout => 10,
};
if ($lock) {
- sysopen(FH, $datafile, O_RDWR | O_TRUNC);
+ sysopen(my $fh, $datafile, O_RDWR | O_TRUNC);
# Immediately put the magic word into the file
- print FH "lock2\n";
- truncate (FH, tell FH);
- close FH;
+ print $fh "lock2\n";
+ truncate ($fh, tell $fh);
+ close $fh;
}
- print WR2 !!$lock; # Send boolean success status down pipe
- close(WR2); # Signal to parent that the Blocking lock is done
- close(RD2);
+ print $wr2 !!$lock; # Send boolean success status down pipe
+ close($wr2); # Signal to parent that the Blocking lock is done
+ close($rd2);
exit; # Release this new lock
}
# test 8
ok 1; # Fork successful
-close (WR2);
+close ($wr2);
# Waiting for child2 to finish its lock status
-my $child2_lock = <RD2>;
-close (RD2);
+my $child2_lock = <$rd2>;
+close ($rd2);
# Report status of the child2_lock.
# This should have been successful.
# test 9
ok ($child2_lock);
# Load up whatever the file says now
-sysopen(FH, $datafile, O_RDONLY);
+sysopen(my $fh2, $datafile, O_RDONLY);
-$_ = <FH>;
+$_ = <$fh2>;
# test 10
ok /lock2/;
-close FH;
+close $fh2;
# Wipe the temporary file
unlink $datafile;
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libfile-nfslock-perl.git
More information about the Pkg-perl-cvs-commits
mailing list