diff -Nru libfile-nfslock-perl-1.20/Changes libfile-nfslock-perl-1.21/Changes --- libfile-nfslock-perl-1.20/Changes 2003-05-13 16:57:32.000000000 +0000 +++ libfile-nfslock-perl-1.21/Changes 2011-07-13 22:29:28.000000000 +0000 @@ -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 -Nru libfile-nfslock-perl-1.20/debian/changelog libfile-nfslock-perl-1.21/debian/changelog --- libfile-nfslock-perl-1.20/debian/changelog 2011-10-17 13:37:34.000000000 +0000 +++ libfile-nfslock-perl-1.21/debian/changelog 2011-08-06 14:56:28.000000000 +0000 @@ -1,3 +1,14 @@ +libfile-nfslock-perl (1.21-1) unstable; urgency=low + + * New upstream release (closes: #636764) + * Add Vcs-* URLs + * Switch to dpkg-source 3.0 (quilt) format + * Use minimal dh7 rules + * Update Standards-Version (no changes) + * Fix POD errors (thanks, Jonas Genannt) + + -- Dominic Hargreaves Sat, 06 Aug 2011 15:56:27 +0100 + libfile-nfslock-perl (1.20-2) unstable; urgency=low * Fix debian/rules rmdir bug (closes: #467824) diff -Nru libfile-nfslock-perl-1.20/debian/compat libfile-nfslock-perl-1.21/debian/compat --- libfile-nfslock-perl-1.20/debian/compat 2011-10-17 13:37:34.000000000 +0000 +++ libfile-nfslock-perl-1.21/debian/compat 2011-08-06 14:51:37.000000000 +0000 @@ -1 +1 @@ -4 +7 diff -Nru libfile-nfslock-perl-1.20/debian/control libfile-nfslock-perl-1.21/debian/control --- libfile-nfslock-perl-1.20/debian/control 2011-10-17 13:37:34.000000000 +0000 +++ libfile-nfslock-perl-1.21/debian/control 2011-08-06 14:51:31.000000000 +0000 @@ -1,11 +1,13 @@ Source: libfile-nfslock-perl Section: perl Priority: optional -Build-Depends: debhelper (>= 4.0.2) +Build-Depends: debhelper (>= 7) Build-Depends-Indep: perl (>= 5.8.0-7) Maintainer: Dominic Hargreaves -Standards-Version: 3.7.3 +Standards-Version: 3.9.2 Homepage: http://search.cpan.org/dist/File-NFSLock/ +Vcs-Git: git://anonscm.debian.org/users/dom/libfile-nfslock-perl.git +Vcs-Browser: http://anonscm.debian.org/gitweb/?p=users/dom/libfile-nfslock-perl.git Package: libfile-nfslock-perl Architecture: all diff -Nru libfile-nfslock-perl-1.20/debian/docs libfile-nfslock-perl-1.21/debian/docs --- libfile-nfslock-perl-1.20/debian/docs 1970-01-01 00:00:00.000000000 +0000 +++ libfile-nfslock-perl-1.21/debian/docs 2011-08-06 14:55:11.000000000 +0000 @@ -0,0 +1 @@ +README diff -Nru libfile-nfslock-perl-1.20/debian/examples libfile-nfslock-perl-1.21/debian/examples --- libfile-nfslock-perl-1.20/debian/examples 1970-01-01 00:00:00.000000000 +0000 +++ libfile-nfslock-perl-1.21/debian/examples 2011-08-06 14:43:40.000000000 +0000 @@ -0,0 +1 @@ +examples/* diff -Nru libfile-nfslock-perl-1.20/debian/patches/pod_error.patch libfile-nfslock-perl-1.21/debian/patches/pod_error.patch --- libfile-nfslock-perl-1.20/debian/patches/pod_error.patch 1970-01-01 00:00:00.000000000 +0000 +++ libfile-nfslock-perl-1.21/debian/patches/pod_error.patch 2011-08-06 14:58:27.000000000 +0000 @@ -0,0 +1,18 @@ +Author: Jonas Genannt +Description: Fix POD errors in Manpage + +Bug: https://rt.cpan.org/Public/Bug/Display.html?id=70105 + +diff --git a/lib/File/NFSLock.pm b/lib/File/NFSLock.pm +index 9dea38a..c271045 100644 +--- a/lib/File/NFSLock.pm ++++ b/lib/File/NFSLock.pm +@@ -621,6 +621,8 @@ recursion load could exist so do_lock will only recurse 10 times (this is only + a problem if the stale_lock_timeout is set too low -- on the order of one or two + seconds). + ++=back ++ + =head1 METHODS + + After the $lock object is instantiated with new, diff -Nru libfile-nfslock-perl-1.20/debian/patches/series libfile-nfslock-perl-1.21/debian/patches/series --- libfile-nfslock-perl-1.20/debian/patches/series 1970-01-01 00:00:00.000000000 +0000 +++ libfile-nfslock-perl-1.21/debian/patches/series 2011-08-06 14:49:44.000000000 +0000 @@ -0,0 +1 @@ +pod_error.patch diff -Nru libfile-nfslock-perl-1.20/debian/rules libfile-nfslock-perl-1.21/debian/rules --- libfile-nfslock-perl-1.20/debian/rules 2011-10-17 13:37:34.000000000 +0000 +++ libfile-nfslock-perl-1.21/debian/rules 2011-08-06 14:43:26.000000000 +0000 @@ -1,84 +1,4 @@ #!/usr/bin/make -f -# This debian/rules file is provided as a template for normal perl -# packages. It was created by Marc Brockschmidt for -# the Debian Perl Group (http://pkg-perl.alioth.debian.org/) but may -# be used freely wherever it is useful. -# Uncomment this to turn on verbose mode. -#export DH_VERBOSE=1 - -# If set to a true value then MakeMaker's prompt function will -# always return the default without waiting for user input. -export PERL_MM_USE_DEFAULT=1 - -PACKAGE=$(shell dh_listpackages) - -ifndef PERL -PERL = /usr/bin/perl -endif - -TMP =$(CURDIR)/debian/$(PACKAGE) - -build: build-stamp -build-stamp: - dh_testdir - - # Add commands to compile the package here - $(PERL) Makefile.PL INSTALLDIRS=vendor - $(MAKE) OPTIMIZE="-Wall -O2 -g" - - touch build-stamp - -clean: - dh_testdir - dh_testroot - - # Add commands to clean up after the build process here - [ ! -f Makefile ] || $(MAKE) distclean - rm -f testfile.dat* - - dh_clean build-stamp install-stamp - -install: build install-stamp -install-stamp: - dh_testdir - dh_testroot - dh_clean -k - - # Add commands to install the package into debian/$PACKAGE_NAME here - $(MAKE) test - $(MAKE) install DESTDIR=$(TMP) PREFIX=/usr - - # As this is a architecture independent package, we are not - # supposed to install stuff to /usr/lib. MakeMaker creates - # the dirs, we delete them from the deb: - [ ! -d $(TMP)/usr/lib/perl5 ] || rmdir --ignore-fail-on-non-empty --parents --verbose $(TMP)/usr/lib/perl5 - - touch install-stamp - -binary-arch: -# We have nothing to do by default. - -binary-indep: build install - dh_testdir - dh_testroot -# dh_installcron -# dh_installmenu - dh_installexamples examples/* - dh_installdocs README - dh_installchangelogs Changes - dh_perl - dh_link - dh_strip - dh_compress - dh_fixperms - dh_installdeb - dh_gencontrol - dh_md5sums - dh_builddeb - -source diff: - @echo >&2 'source and diff are obsolete - use dpkg-source -b'; false - -binary: binary-indep binary-arch -.PHONY: build clean binary-indep binary-arch binary +%: + dh $@ diff -Nru libfile-nfslock-perl-1.20/debian/source/format libfile-nfslock-perl-1.21/debian/source/format --- libfile-nfslock-perl-1.20/debian/source/format 1970-01-01 00:00:00.000000000 +0000 +++ libfile-nfslock-perl-1.21/debian/source/format 2011-10-17 13:37:34.000000000 +0000 @@ -0,0 +1 @@ +3.0 (quilt) diff -Nru libfile-nfslock-perl-1.20/File-NFSLock.spec libfile-nfslock-perl-1.21/File-NFSLock.spec --- libfile-nfslock-perl-1.20/File-NFSLock.spec 2003-05-13 18:06:45.000000000 +0000 +++ libfile-nfslock-perl-1.21/File-NFSLock.spec 2011-07-14 01:56:07.000000000 +0000 @@ -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 -Nru libfile-nfslock-perl-1.20/lib/File/NFSLock.pm libfile-nfslock-perl-1.21/lib/File/NFSLock.pm --- libfile-nfslock-perl-1.20/lib/File/NFSLock.pm 2003-05-13 18:06:42.000000000 +0000 +++ libfile-nfslock-perl-1.21/lib/File/NFSLock.pm 2011-07-14 01:56:03.000000000 +0000 @@ -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; -@ISA = qw(Exporter); -@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 @@ 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 @@ exit; }; -@CATCH_SIGS = qw(TERM INT); +our @CATCH_SIGS = qw(TERM INT); sub new { $errstr = undef; @@ -107,7 +107,7 @@ ### need the hostname if( !$HOSTNAME ){ require Sys::Hostname; - $HOSTNAME = &Sys::Hostname::hostname(); + $HOSTNAME = Sys::Hostname::hostname(); } ### quick usage check @@ -160,8 +160,9 @@ ### 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 @@ 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 @@ ### 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 @@ ### 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 @@ 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 @@ 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 @@ ### 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 @@ $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 -Nru libfile-nfslock-perl-1.20/MANIFEST libfile-nfslock-perl-1.21/MANIFEST --- libfile-nfslock-perl-1.20/MANIFEST 2002-12-18 03:38:45.000000000 +0000 +++ libfile-nfslock-perl-1.21/MANIFEST 2011-07-13 22:31:01.000000000 +0000 @@ -18,3 +18,4 @@ t/400_kill.t t/410_die.t t/420_crash.t +META.yml Module meta-data (added by MakeMaker) diff -Nru libfile-nfslock-perl-1.20/META.yml libfile-nfslock-perl-1.21/META.yml --- libfile-nfslock-perl-1.20/META.yml 1970-01-01 00:00:00.000000000 +0000 +++ libfile-nfslock-perl-1.21/META.yml 2011-07-14 01:56:38.000000000 +0000 @@ -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 -Nru libfile-nfslock-perl-1.20/README libfile-nfslock-perl-1.21/README --- libfile-nfslock-perl-1.20/README 2003-05-13 18:06:44.000000000 +0000 +++ libfile-nfslock-perl-1.21/README 2011-07-14 01:56:07.000000000 +0000 @@ -123,7 +123,6 @@ 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 @@ scope it is in. uncache - $lock->uncache; $lock->uncache("otherfile1"); uncache("otherfile2"); @@ -144,7 +142,6 @@ as a stand alone subroutine. newpid - my $pid = fork; if (defined $pid) { # Fork Failed @@ -179,14 +176,12 @@ Notify paul@seamons.com or bbb@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 -Nru libfile-nfslock-perl-1.20/t/100_load.t libfile-nfslock-perl-1.21/t/100_load.t --- libfile-nfslock-perl-1.20/t/100_load.t 2001-11-06 00:17:57.000000000 +0000 +++ libfile-nfslock-perl-1.21/t/100_load.t 2011-07-12 20:25:33.000000000 +0000 @@ -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 -Nru libfile-nfslock-perl-1.20/t/110_compare.t libfile-nfslock-perl-1.21/t/110_compare.t --- libfile-nfslock-perl-1.20/t/110_compare.t 2001-11-02 00:32:19.000000000 +0000 +++ libfile-nfslock-perl-1.21/t/110_compare.t 2011-07-12 20:25:33.000000000 +0000 @@ -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 -Nru libfile-nfslock-perl-1.20/t/120_single.t libfile-nfslock-perl-1.21/t/120_single.t --- libfile-nfslock-perl-1.20/t/120_single.t 2002-12-18 03:38:46.000000000 +0000 +++ libfile-nfslock-perl-1.21/t/120_single.t 2011-07-12 20:25:33.000000000 +0000 @@ -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 @@ file => $datafile, lock_type => LOCK_EX, }; - sysopen(FH, $datafile, O_RDWR); + sysopen(my $fh, $datafile, O_RDWR); # Read the current value - my $count = ; + 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); -$_ = ; -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 -Nru libfile-nfslock-perl-1.20/t/200_bl_ex.t libfile-nfslock-perl-1.21/t/200_bl_ex.t --- libfile-nfslock-perl-1.20/t/200_bl_ex.t 2001-11-02 00:32:19.000000000 +0000 +++ libfile-nfslock-perl-1.21/t/200_bl_ex.t 2011-07-14 01:39:45.000000000 +0000 @@ -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 $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 @@ file => $datafile, lock_type => LOCK_EX, }; - sysopen(FH, $datafile, O_RDWR); + sysopen(my $fh, $datafile, O_RDWR); # Read the current value - my $count = ; + 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 @@ } # Load up whatever the file says now -sysopen(FH, $datafile, O_RDONLY); -$_ = ; -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 -Nru libfile-nfslock-perl-1.20/t/210_nb_ex.t libfile-nfslock-perl-1.21/t/210_nb_ex.t --- libfile-nfslock-perl-1.20/t/210_nb_ex.t 2001-11-02 17:32:06.000000000 +0000 +++ libfile-nfslock-perl-1.21/t/210_nb_ex.t 2011-07-12 20:25:33.000000000 +0000 @@ -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 = ; -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 = ; -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 @@ wait; wait; # Load up whatever the file says now -sysopen(FH, $datafile, O_RDONLY); -$_ = ; -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 -Nru libfile-nfslock-perl-1.20/t/220_ex_scope.t libfile-nfslock-perl-1.21/t/220_ex_scope.t --- libfile-nfslock-perl-1.20/t/220_ex_scope.t 2002-05-31 23:42:22.000000000 +0000 +++ libfile-nfslock-perl-1.21/t/220_ex_scope.t 2011-07-12 20:25:33.000000000 +0000 @@ -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 = ; -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 = ; -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 = ; -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 @@ wait; wait; wait; # Load up whatever the file says now -sysopen(FH, $datafile, O_RDONLY); -$_ = ; -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 -Nru libfile-nfslock-perl-1.20/t/230_double.t libfile-nfslock-perl-1.21/t/230_double.t --- libfile-nfslock-perl-1.20/t/230_double.t 2002-07-26 04:56:13.000000000 +0000 +++ libfile-nfslock-perl-1.21/t/230_double.t 2011-07-12 20:25:33.000000000 +0000 @@ -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 @@ 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 @@ 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 @@ 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); -$_ = ; +sysopen(my $fh4, $datafile, O_RDONLY); +$_ = <$fh4>; ok /lock1/; -$_ = ; +$_ = <$fh4>; ok /lock2/; -close FH; +close $fh4; # Wipe the temporary file unlink $datafile; diff -Nru libfile-nfslock-perl-1.20/t/240_fork.t libfile-nfslock-perl-1.21/t/240_fork.t --- libfile-nfslock-perl-1.20/t/240_fork.t 2002-07-26 04:56:13.000000000 +0000 +++ libfile-nfslock-perl-1.21/t/240_fork.t 2011-07-12 20:25:33.000000000 +0000 @@ -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 @@ 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 -Nru libfile-nfslock-perl-1.20/t/300_bl_sh.t libfile-nfslock-perl-1.21/t/300_bl_sh.t --- libfile-nfslock-perl-1.20/t/300_bl_sh.t 2002-12-18 03:38:46.000000000 +0000 +++ libfile-nfslock-perl-1.21/t/300_bl_sh.t 2011-07-12 20:25:33.000000000 +0000 @@ -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 $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 @@ 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 = ; -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 @@ 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 @@ # 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 @@ } # test 6 ok 1; # Fork successful -close (WR2); +close ($wr2); # Waiting for child2 to finish its lock status -my $child2_lock = ; -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 @@ # 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 @@ 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 @@ } # 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 = ; + my $got_shared_lock = <$rd3>; # test 9 .. 8+$m ok $got_shared_lock; } # There should not be anything left in the pipe. -my $extra = ; +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 @@ } # 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. -$_ = ; +$_ = <$fh2>; # test 13 + 2*$m ok /shared/; for (my $i = 0; $i < $m ; $i++) { - $_ = ; + $_ = <$fh2>; chomp; # test 14+2*$m .. 13+3*$m - ok $_, 1; + is $_, 1; } -close FH; +close $fh2; # Wipe the temporary file unlink $datafile; diff -Nru libfile-nfslock-perl-1.20/t/400_kill.t libfile-nfslock-perl-1.21/t/400_kill.t --- libfile-nfslock-perl-1.20/t/400_kill.t 2002-06-05 14:37:01.000000000 +0000 +++ libfile-nfslock-perl-1.21/t/400_kill.t 2011-07-12 20:25:33.000000000 +0000 @@ -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 @@ 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 @@ 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 = ; -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 (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 @@ 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 = ; -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); -$_ = ; +$_ = <$fh2>; # test 10 ok /lock2/; -close FH; +close $fh2; # Wipe the temporary file unlink $datafile; diff -Nru libfile-nfslock-perl-1.20/t/410_die.t libfile-nfslock-perl-1.21/t/410_die.t --- libfile-nfslock-perl-1.20/t/410_die.t 2002-06-05 14:37:45.000000000 +0000 +++ libfile-nfslock-perl-1.21/t/410_die.t 2011-07-12 20:25:33.000000000 +0000 @@ -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 @@ 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 @@ 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 @@ # test 3 ok 1; # Fork successful -close (WR1); +close ($wr1); # Waiting for child1 to finish its lock status -my $child1_lock = ; -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 (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 @@ 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 = ; -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); -$_ = ; +$_ = <$fh2>; # test 9 ok /lock2/; -close FH; +close $fh2; # Wipe the temporary file unlink $datafile; diff -Nru libfile-nfslock-perl-1.20/t/420_crash.t libfile-nfslock-perl-1.21/t/420_crash.t --- libfile-nfslock-perl-1.20/t/420_crash.t 2002-06-05 23:20:20.000000000 +0000 +++ libfile-nfslock-perl-1.21/t/420_crash.t 2011-07-12 20:25:33.000000000 +0000 @@ -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 @@ 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 @@ 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 = ; -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 (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 @@ 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 = ; -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); -$_ = ; +$_ = <$fh2>; # test 10 ok /lock2/; -close FH; +close $fh2; # Wipe the temporary file unlink $datafile;