| Subject: | Allow multiple File::Lockfile objects to be used |
The current version (1.0.5) of File::Lockfile mimics an object oriented
behaviour, but stores the lockfile in a class attribute, although new is
allowed to overwrite this class attribute leaving the previously
generated object with a wrong lockfile (as on every call to remove/check
the updated $class->lockfile is used).
As this can cause pretty bad headaches when using multiple
File::Lockfile objects the attached patch corrects this (also fixed
ticket #62595).
For backwards compatibility the ackward behaviour is mimics using a
singleton class variable (that cannot be overridden yet).
Please consider patching.
| Subject: | File-LockFile_105_110.patch |
diff -ru File-Lockfile-v1.0.5//File/Lockfile.pm File-Lockfile-1.1.0//File/Lockfile.pm
--- File-Lockfile-v1.0.5//File/Lockfile.pm 2011-01-07 02:24:25.000000000 +0100
+++ File-Lockfile-1.1.0//File/Lockfile.pm 2011-01-07 02:21:41.000000000 +0100
@@ -2,44 +2,57 @@
use strict;
use warnings;
+use File::Spec;
-use version; our $VERSION = qv('1.0.5');
+our $VERSION = '1.1.0';
-require Class::Data::Inheritable;
-use base qw(Class::Data::Inheritable);
-
-__PACKAGE__->mk_classdata(qw/lockfile/);
+my $singleton;
sub new {
my ($class, $filename, $dir) = @_;
- $class->lockfile(join("/", $dir, $filename));
- return bless {}, $class;
+ my $self = bless {}, $class;
+ $self->lockfile(File::Spec->catfile($dir, $filename));
+ $singleton = $self;
+ return $self;
+}
+
+sub lockfile {
+ my ($self, $lockfile) = @_;
+ $self->{lockfile} = $lockfile if $lockfile;
+ return $self->{lockfile};
}
sub write {
+ my ($self) = @_;
+ my $lockfile = $self->lockfile;
my $fh;
- open $fh, '>', __PACKAGE__->lockfile or die("Can't write lockfile: ".__PACKAGE__->lockfile.": $!");
+ open $fh, '>', $lockfile or die("Can't write lockfile: " . $lockfile . ": $!");
print $fh $$;
close $fh;
}
sub remove {
- unlink __PACKAGE__->lockfile;
+ my ($self) = @_;
+ my $lockfile = $self->lockfile;
+ ### For backwards compatibility to 1.0.5 only
+ $lockfile = $singleton->lockfile if (!$lockfile && $singleton->lockfile);
+
+ unlink $lockfile;
}
sub check {
- my ($class, $lockfile) = @_;
+ my ($self, $lockfile) = @_;
- $lockfile = __PACKAGE__->lockfile unless $lockfile;
+ $lockfile = $self->lockfile unless $lockfile;
if ( -s $lockfile ) {
my $fh;
- open $fh, '<', $lockfile or die("Can't open lockfile for reading: ".__PACKAGE->lockfile.": $!");
+ open $fh, '<', $lockfile or die("Can't open lockfile for reading: ".$lockfile.": $!");
my $pid = <$fh>;
my $running = kill 0, $pid;
return $pid if $running;
}
- return undef;
+ return;
}
1;