File Coverage

blib/lib/Lazy/Lockfile.pm
Criterion Covered Total %
statement 78 93 83.8
branch 19 38 50.0
condition 11 24 45.8
subroutine 10 11 90.9
pod 4 4 100.0
total 122 170 71.7


line stmt bran cond sub pod time code
1             package Lazy::Lockfile;
2              
3 1     1   18891 use strict;
  1         1  
  1         33  
4 1     1   5 use Fcntl qw/ :DEFAULT :flock /;
  1         2  
  1         440  
5 1     1   1121 use POSIX qw/ :errno_h /;
  1         12368  
  1         7  
6 1     1   1687 use File::Basename;
  1         2  
  1         122  
7              
8 1     1   6 use vars qw( $VERSION );
  1         2  
  1         428  
9             ( $VERSION ) = '1.21';
10              
11             =head1 NAME
12              
13             Lazy::Lockfile - File based locking for the lazy.
14              
15             =head1 SYNOPSIS
16              
17             use Lazy::Lockfile;
18              
19             my $lockfile = Lazy::Lockfile->new() || die "Couldn't get lock!";
20             ...
21             # Lock is released when $lockfile goes out of scope or your program exits.
22              
23             =head1 DESCRIPTION
24              
25             Lazy::Lockfile is a module designed for simple locking through the use of
26             lockfiles, requiring very little effort on the part of the developer. Once the
27             object is instanced, the lock will be held as long as object exists. When the
28             object is destroyed, the lock is released.
29              
30             Locks are based around the existence of a named file, not around the use of
31             L (though flock is used to synchronize access to the lock file).
32             Lazy::Lockfile is (usually) smart enough to detect stale lockfiles from PIDs no
33             longer running by placing the PID of the process holding the lock inside the
34             lockfile.
35              
36             =head1 NOTES
37              
38             Lazy::Lockfile is not safe for use on NFS volumes.
39              
40             Lazy::Lockfile is not tested to interact correctly with other file locking
41             systems when used on the same lockfile.
42              
43             Lazy::Lockfile uses kill (with signal zero) to determine if the lockfile is
44             stale. This works on most systems running as most users but there are likely
45             instances where this will fail. If this applies to your system, you can use the
46             L option to disable the check.
47              
48             If Lazy::Lockfile encounters a malformed lockfile (empty, containing other
49             text, etc), it will treat it as a corrupt file and overwrite it, assuming the
50             lock. The author believes this behavior should be changed (and malformed files
51             should be left untouched), but has kept this behavior for backwards
52             compatibility.
53              
54             =head1 USAGE
55              
56             All of the magic in Lazy::Lockfile is done through the constructor and
57             destructor.
58              
59             =head1 METHODS
60              
61             =head2 new
62              
63             Constructor for Lazy::Lockfile.
64              
65             =head3 Parameters
66              
67             Accepts a single optional parameter, a hashref containing the following
68             options:
69              
70             =head4 location
71              
72             Specifies the full path to the location of the lockfile. Defaults to:
73              
74             '/tmp/' . (fileparse($0))[0] . '.pid'
75              
76             i.e., the name of the program being run, with a ".pid" extension, in /tmp/.
77              
78             =head4 no_pid
79              
80             If true, instead of writing the PID file, a value of "0" is written instead.
81             When read by another instance of Lazy::Lockfile attempting to acquire the lock,
82             no PID check will be performed and the lock will be assumed to be active as
83             long as the file exists. Defaults to false.
84              
85             =head4 delete_on_destroy
86              
87             If true, sets the "delete on destroy" flag. This flag defaults to true, which
88             causes the lockfile to be removed when the object is destroyed. Generally,
89             this is the desired behavior. When set to false, this flag prevents the
90             lockfile from being removed automatically when the object is destroyed. See
91             also C.
92              
93             =head3 Compatibility
94              
95             For compatibility with older versions of Lazy::Lockfile (pre-1.0), a single
96             optional parameter is accepted, the path to the lockfile. This parameter
97             functions the same as the 'location' parameter described above.
98              
99             As stated above, malformed lockfiles will be overwritten, though this may be
100             subject to change in a future version.
101              
102             =head3 Return value
103              
104             If the lock can not be obtained, undef is returned (and $! will contain useful
105             information). Otherwise, the lock is exclusive to this process, as long as the
106             object exists.
107              
108             =head3 Example
109              
110             my $lockfile = Lazy::Lockfile->new( { location => "/var/lock", no_pid => 1 } )
111             || die "Couldn't get lock!";
112              
113             =cut
114              
115             sub new {
116 3     3 1 332 my ( $class, $params ) = @_;
117 3         5 my $self = {};
118 3         4 my $lockfile_location;
119              
120             # Yargh, backwards compatibility ahoy!
121 3 50       8 if ( ref $params ne 'HASH' ) {
122 3         3 $lockfile_location = $params;
123 3         4 $params = {};
124             } else {
125 0 0       0 if ( !defined $params ) {
126 0         0 $params = {};
127             }
128 0         0 $lockfile_location = $params->{'location'};
129             }
130              
131 3 50 33     10 if ( ( !defined $lockfile_location ) || ( $lockfile_location eq '' ) ) {
132 3         66 $lockfile_location = '/tmp/' . (fileparse($0))[0] . '.pid';
133             }
134              
135 3         7 my $lock_tries = 0;
136 3         3 my ( $lock, $file_pid );
137              
138             # If we return here, sysopen will set $! for us.
139 3 50       336 sysopen( $lock, $lockfile_location, O_RDWR | O_CREAT | O_NOFOLLOW, 0644 ) or return;
140 3         11 while ( $lock_tries++ < 5 ) {
141 3 50       19 if ( flock( $lock, LOCK_NB | LOCK_EX ) ) {
142 3         4 last;
143             }
144 0         0 sleep( 1 );
145             }
146 3 50       7 if ( $lock_tries > 5 ) {
147 0         0 close( $lock );
148 0         0 $! = EWOULDBLOCK;
149 0         0 return;
150             }
151 3         11 seek( $lock, 0, 0 );
152 3         63 $file_pid = <$lock>;
153              
154 3 100       8 if ( defined $file_pid ) {
155 1         8 ( $file_pid ) = $file_pid =~ /^(\d+)/;
156             }
157             # Would it be better to detect the broken file and return a different error?
158             # if ( ( !defined $file_pid ) && ( $file_pid eq '' ) )
159             # flock( $lock, LOCK_UN );
160             # close( $lock );
161             # $! = EFTYPE;
162             # return;
163             # }
164 3 50 66     38 if (
      33        
      66        
165             ( ( defined $file_pid ) && ( $file_pid ne '' ) )
166             &&
167 1     1   1182 ( ( $file_pid == 0 ) || ( kill( 0, $file_pid ) || $!{EPERM} ) )
  1         1711  
  1         661  
168             ) {
169 1         7 flock( $lock, LOCK_UN );
170 1         10 close( $lock );
171 1         3 $! = EEXIST;
172 1         5 return;
173             }
174              
175 2         9 seek( $lock, 0, 0 );
176 2         56 truncate( $lock, 0 );
177 2 50       6 if ( $params->{'no_pid'} ) {
178 0         0 print $lock "0\n";
179             } else {
180 2         9 print $lock "$$\n";
181             }
182 2         68 flock( $lock, LOCK_UN );
183 2         18 close( $lock );
184 2         5 bless $self, $class;
185 2         10 $self->{'lockfile_location'} = $lockfile_location;
186              
187 2 50       6 if ( defined $params->{'delete_on_destroy'} ) {
188 0 0       0 $self->{'delete_on_destroy'} = $params->{'delete_on_destroy'} ? 1 : 0;
189             } else {
190 2         4 $self->{'delete_on_destroy'} = 1;
191             }
192              
193 2         10 return $self;
194             }
195              
196             =head2 name
197              
198             Returns the file name of the lockfile.
199              
200             =cut
201              
202             sub name {
203 0     0 1 0 my ( $self ) = @_;
204 0         0 return $self->{'lockfile_location'};
205             }
206              
207             =head2 delete_on_destroy
208              
209             Gets or sets the "delete on destroy" flag.
210              
211             If called without a parameter (or with undef), delete_on_destroy will return
212             the current state of the "delete on destroy" flag. If called with a parameter,
213             this flag will be set.
214              
215             =cut
216              
217             sub delete_on_destroy {
218 1     1 1 2 my ( $self, $new_setting ) = @_;
219              
220 1 50       3 if ( !defined $new_setting ) {
221 0         0 return $self->{'delete_on_destroy'};
222             } else {
223 1 50       5 $self->{'delete_on_destroy'} = $new_setting ? 1 : 0;
224 1         1 return;
225             }
226             }
227              
228             =head2 unlock
229              
230             Explicitly removes the lockfile, just as if the object were destroyed. Once
231             this has been called, delete_on_destroy will be set to false, since the lock
232             has already been deleted. Once this method is called, there is not much use
233             left for the object, so the user may as well delete it now.
234              
235             unlock should be used when the lockfile needs to be removed deterministically
236             while the program is running. If you simply remove all references to the
237             Lazy::Lockfile object, the lock will be freed when garbage collection is run,
238             which is not guaranteed to happen until the program exits (though it will
239             likely happen immediately).
240              
241             Returns a true value if the lockfile was found and removed, false otherwise.
242              
243             =cut
244              
245             sub unlock {
246 1     1 1 238 my ( $self ) = @_;
247 1         5 my $retval = $self->DESTROY;
248 1         4 $self->delete_on_destroy(0);
249 1         4 return $retval;
250             }
251              
252             # Make sure the lockfile contains our pid before we delete it...
253             # do we need this?
254             sub DESTROY {
255 3     3   256 my ( $self ) = @_;
256 3         6 my $retval = 0;
257 3 100 33     24 if ( ( $self ) && ( $self->{'lockfile_location'} ) && ( $self->{'delete_on_destroy'} ) ) {
      66        
258 2         4 my ( $lock, $file_pid );
259 2         3 my $lock_tries = 0;
260 2 50       81 open( $lock, '<', $self->{'lockfile_location'} ) || return 0;
261 2         5 while ( $lock_tries++ < 5 ) {
262 2 50       14 if ( flock( $lock, LOCK_NB | LOCK_EX ) ) {
263 2         3 last;
264             }
265 0         0 sleep( 1 );
266             }
267 2 50       5 if ( $lock_tries > 5 ) { close( $lock ); return 0; }
  0         0  
  0         0  
268 2         10 seek( $lock, 0, 0 );
269 2         15 $file_pid = <$lock>;
270 2 50       8 chomp( $file_pid ) if defined $file_pid;
271 2 50 33     40 if ( ( defined $file_pid ) && ( ( $file_pid == 0 ) || ( $file_pid == $$ ) ) ) {
      33        
272 2         98 $retval = unlink $self->{'lockfile_location'};
273             }
274 2         92 close( $lock );
275             }
276 3         100 return $retval;
277             }
278              
279             =head1 CHANGES
280              
281             =head2 2014-09-14, 1.21 - jeagle
282              
283             Re-package to make it easier to convert to RPM, etc.
284              
285             =head2 2012-04-01, 1.20 - jeagle
286              
287             Updated documentation, thanks Alister W.
288              
289             =head2 2011-01-05, 1.19 - jeagle
290              
291             Change to unit tests to appease cpantesters.
292              
293             =head2 2011-01-04, 1.18 - jeagle
294              
295             Implement suggestion by srezic to check PIDs belonging to other users
296             (RT#69185).
297              
298             Clean up documentation.
299              
300             =head2 2010-06-22, 1.17 - jeagle
301              
302             Update L to return a useful status.
303              
304             =head2 2010-06-22, 1.16 - jeagle
305              
306             Version bumps for migration to CPAN.
307              
308             =head2 2009-12-03, 1.14 - jeagle
309              
310             Fix a bug causing lockfiles with no_pid to not be deleted on destroy/unlink.
311              
312             =head2 2009-12-03, 1.13 - jeagle
313              
314             Add the unlock method, to allow for deterministic lockfile removal at runtime.
315              
316             =head2 2009-11-30, 1.12 - jeagle
317              
318             Update documentation to clarify delete_on_destroy parameter default setting.
319              
320             =head2 2009-07-06, 1.11 - jeagle
321              
322             Fix error thrown when running with taint checking enabled.
323              
324             =head2 2009-07-06, 1.10 - jeagle
325              
326             Fix a bug with lockfile location being overwritten with the default.
327              
328             =head2 2009-07-06, 1.9 - jeagle
329              
330             Add new parameter, no_pid, which disabled active lockfile checks.
331              
332             Allow constructor to accept multiple parameters via hashref.
333              
334             =head2 2009-06-10, 0.4 - jeagle
335              
336             Introduce the delete_on_destroy flag.
337              
338             =head2 2009-06-03, 0.3 - jeagle
339              
340             Open pid file with O_NOFOLLOW, to avoid symlink attacks.
341              
342             Change default pid file location from /var/tmp to /tmp.
343              
344             Correct dates in CHANGES section.
345              
346             Add useful error indicators, documentation on error detection.
347              
348             =head2 2009-04-27, 0.2 - jeagle
349              
350             Fix a bug with unspecified lockfile paths trying to create impossible file
351             names.
352              
353             =head2 2009-04-06, v0.1 - jeagle
354              
355             Initial release.
356              
357             =cut
358              
359             1;