This file is indexed.

/usr/share/perl5/LockFile/Simple.pm is in liblockfile-simple-perl 0.208-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
;# $Id$
;#
;#  @COPYRIGHT@
;#
;# $Log: Simple.pm,v $
;# Revision 0.4  2007/09/28 19:22:05  jv
;# Bump version.
;#
;# Revision 0.3  2007/09/28 19:19:41  jv
;# Revision 0.2.1.5  2000/09/18 19:55:07  ram
;# patch5: fixed computation of %F and %D when no '/' in file name
;# patch5: fixed OO example of lock to emphasize check on returned value
;# patch5: now warns when no lockfile is found during unlocking
;#
;# Revision 0.2.1.4  2000/08/15 18:41:43  ram
;# patch4: updated version number, grrr...
;#
;# Revision 0.2.1.3  2000/08/15 18:37:37  ram
;# patch3: fixed non-working "-wfunc => undef" due to misuse of defined()
;# patch3: check for stale lock while we wait for it
;# patch3: untaint pid before running kill() for -T scripts
;#
;# Revision 0.2.1.2  2000/03/02 22:35:02  ram
;# patch2: allow "undef" in -efunc and -wfunc to suppress logging
;# patch2: documented how to force warn() despite Log::Agent being there
;#
;# Revision 0.2.1.1  2000/01/04 21:18:10  ram
;# patch1: logerr and logwarn are autoloaded, need to check something real
;# patch1: forbid re-lock of a file we already locked
;# patch1: force $\ to be undef prior to writing the PID to lockfile
;# patch1: track where lock was issued in the code
;#
;# Revision 0.2.1.5  2000/09/18 19:55:07  ram
;# patch5: fixed computation of %F and %D when no '/' in file name
;# patch5: fixed OO example of lock to emphasize check on returned value
;# patch5: now warns when no lockfile is found during unlocking
;#
;# Revision 0.2.1.4  2000/08/15 18:41:43  ram
;# patch4: updated version number, grrr...
;#
;# Revision 0.2.1.3  2000/08/15 18:37:37  ram
;# patch3: fixed non-working "-wfunc => undef" due to misuse of defined()
;# patch3: check for stale lock while we wait for it
;# patch3: untaint pid before running kill() for -T scripts
;#
;# Revision 0.2.1.2  2000/03/02 22:35:02  ram
;# patch2: allow "undef" in -efunc and -wfunc to suppress logging
;# patch2: documented how to force warn() despite Log::Agent being there
;#
;# Revision 0.2.1.1  2000/01/04 21:18:10  ram
;# patch1: logerr and logwarn are autoloaded, need to check something real
;# patch1: forbid re-lock of a file we already locked
;# patch1: force $\ to be undef prior to writing the PID to lockfile
;# patch1: track where lock was issued in the code
;#
;# Revision 0.2  1999/12/07 20:51:05  ram
;# Baseline for 0.2 release.
;#

use strict;

########################################################################
package LockFile::Simple;

#
# This package extracts the simple locking logic used by mailagent-3.0
# into a standalone Perl module to be reused in other applications.
#

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

use Sys::Hostname;
require Exporter;
require LockFile::Lock::Simple;
eval "use Log::Agent";

@ISA = qw(Exporter);
@EXPORT = ();
@EXPORT_OK = qw(lock trylock unlock);
$VERSION = '0.208';

my $LOCKER = undef;			# Default locking object

#
# ->make
#
# Create a file locking object, responsible for holding the locking
# parameters to be used by all the subsequent locks requested from
# this locking object.
#
# Configuration attributes:
#
#	autoclean		keep track of locks and release pending one at END time
#   max				max number of attempts
#	delay			seconds to wait between attempts
#	format			how to derive lockfile from file to be locked
#	hold			max amount of seconds before breaking lock (0 for never)
#	ext				lock extension
#	nfs				true if lock must "work" on top of NFS
#	stale			try to detect stale locks via SIGZERO and delete them
#	warn			flag to turn warnings on
#	wmin			warn once after that many waiting seconds
#	wafter			warn every that many seconds after first warning
#	wfunc			warning function to be called
#	efunc			error function to be called
#
# Additional attributes:
#
#	manager			lock manager, used when autoclean
#	lock_by_file	returns lock by filename
#
# The creation routine first and sole argument is a "hash table list" listing
# all the configuration attributes. Missing attributes are given a default
# value. A call to ->configure can alter the configuration parameters of
# an existing object.
#
sub make {
	my $self = bless {}, shift;
	my (@hlist) = @_;

	# Set configuration defaults, then override with user preferences
	$self->{'max'} = 30;
	$self->{'delay'} = 2;
	$self->{'hold'} = 3600;
	$self->{'ext'} = '.lock';
	$self->{'nfs'} = 0;
	$self->{'stale'} = 0;
	$self->{'warn'} = 1;
	$self->{'wmin'} = 15;
	$self->{'wafter'} = 20;
	$self->{'autoclean'} = 0;
	$self->{'lock_by_file'} = {};

	# The logxxx routines are autoloaded, so need to check for @EXPORT
	$self->{'wfunc'} = @Log::Agent::EXPORT ? \&logwarn : \&core_warn;
	$self->{'efunc'} = @Log::Agent::EXPORT ?  \&logerr  : \&core_warn;

	$self->configure(@hlist);		# Will init "manager" if necessary
	return $self;
}

#
# ->locker		-- "once" function
#
# Compute the default locking object.
#
sub locker {
	return $LOCKER || ($LOCKER = LockFile::Simple->make('-warn' => 1));
}

#
# ->configure
#
# Extract known configuration parameters from the specified hash list
# and use their values to change the object's corresponding parameters.
#
# Parameters are specified as (-warn => 1, -ext => '.lock') for instance.
#
sub configure {
	my $self = shift;
	my (%hlist) = @_;
	my @known = qw(
		autoclean
		max delay hold format ext nfs warn wfunc wmin wafter efunc stale
	);

	foreach my $attr (@known) {
		$self->{$attr} = $hlist{"-$attr"} if exists $hlist{"-$attr"};
	}

	$self->{'wfunc'} = \&no_warn unless defined $self->{'wfunc'};
	$self->{'efunc'} = \&no_warn unless defined $self->{'efunc'};

	if ($self->autoclean) {
		require LockFile::Manager;
		# Created via "once" function
		$self->{'manager'} = LockFile::Manager->manager(
			$self->wfunc, $self->efunc);
	}
}

#
# Attribute access
#

sub max				{ $_[0]->{'max'} }
sub delay			{ $_[0]->{'delay'} }
sub format			{ $_[0]->{'format'} }
sub hold			{ $_[0]->{'hold'} }
sub nfs				{ $_[0]->{'nfs'} }
sub stale			{ $_[0]->{'stale'} }
sub ext				{ $_[0]->{'ext'} }
sub warn			{ $_[0]->{'warn'} }
sub wmin			{ $_[0]->{'wmin'} }
sub wafter			{ $_[0]->{'wafter'} }
sub wfunc			{ $_[0]->{'wfunc'} }
sub efunc			{ $_[0]->{'efunc'} }
sub autoclean		{ $_[0]->{'autoclean'} }
sub lock_by_file	{ $_[0]->{'lock_by_file'} }
sub manager			{ $_[0]->{'manager'} }

#
# Warning and error reporting -- Log::Agent used only when available
#

sub core_warn	{ CORE::warn(@_) }
sub no_warn		{ return }

#
# ->lock
#
# Lock specified file, possibly using alternate file "format".
# Returns whether file was locked or not at the end of the configured
# blocking period by providing the LockFile::Lock instance if successful.
#
# For quick and dirty scripts wishing to use locks, create the locking
# object if not invoked as a method, turning on warnings.
#
sub lock {
	my $self = shift;
	unless (ref $self) {			# Not invoked as a method
		unshift(@_, $self);
		$self = locker();
	}
	my ($file, $format) = @_;		# File to be locked, lock format
	return $self->take_lock($file, $format, 0);
}

#
# ->trylock
#
# Attempt to lock specified file, possibly using alternate file "format".
# If the file is already locked, don't block and return undef. The
# LockFile::Lock instance is returned upon success.
#
# For quick and dirty scripts wishing to use locks, create the locking
# object if not invoked as a method, turning on warnings.
#
sub trylock {
	my $self = shift;
	unless (ref $self) {			# Not invoked as a method
		unshift(@_, $self);
		$self = locker();
	}
	my ($file, $format) = @_;		# File to be locked, lock format
	return $self->take_lock($file, $format, 1);
}

#
# ->take_lock
#
# Common code for ->lock and ->trylock.
# Returns a LockFile::Lock object on success, undef on failure.
#
sub take_lock {
	my $self = shift;
	my ($file, $format, $tryonly) = @_;

	#
	# If lock was already taken by us, it's an error when $tryonly is 0.
	# Otherwise, simply fail to get the lock.
	#

	my $lock = $self->lock_by_file->{$file};
	if (defined $lock) {
		my $where = $lock->where;
		&{$self->efunc}("file $file already locked at $where") unless $tryonly;
		return undef;
	}

	my $locked = $self->_acs_lock($file, $format, $tryonly);
	return undef unless $locked;

	#
	# Create LockFile::Lock object
	#

	my ($package, $filename, $line) = caller(1);
	$lock = LockFile::Lock::Simple->make($self, $file, $format,
		$filename, $line);
	$self->manager->remember($lock) if $self->autoclean;
	$self->lock_by_file->{$file} = $lock;

	return $lock;
}

#
# ->unlock
#
# Unlock file.
# Returns true if file was unlocked.
#
sub unlock {
	my $self = shift;
	unless (ref $self) {			# Not invoked as a method
		unshift(@_, $self);
		$self = locker();
	}
	my ($file, $format) = @_;		# File to be unlocked, lock format

	if (defined $format) {
		require Carp;
		Carp::carp("2nd argument (format) is no longer needed nor used");
	}

	#
	# Retrieve LockFile::Lock object
	#

	my $lock = $self->lock_by_file->{$file};

	unless (defined $lock) {
		&{$self->efunc}("file $file not currently locked");
		return undef;
	}

	return $self->release($lock);
}

#
# ->release			-- not exported (i.e. not documented)
#
# Same a unlock, but we're passed a LockFile::Lock object.
# And we MUST be called as a method (usually via LockFile::Lock, not user code).
#
# Returns true if file was unlocked.
#
sub release {
	my $self = shift;
	my ($lock) = @_;
	my $file = $lock->file;
	my $format = $lock->format;
	$self->manager->forget($lock) if $self->autoclean;
	delete $self->lock_by_file->{$file};
	return $self->_acs_unlock($file, $format);
}

#
# ->lockfile
#
# Return the name of the lockfile, given the file name to lock and the custom
# string provided by the user. The following macros are substituted:
#	%D: the file dir name
#   %f: the file name (full path)
#   %F: the file base name (last path component)
#   %p: the process's pid
#   %%: a plain % character
#
sub lockfile {
	my $self = shift;
	my ($file, $format) = @_;
	local $_ = defined($format) ? $format : $self->format;
	s/%%/\01/g;				# Protect double percent signs
	s/%/\02/g;				# Protect against substitutions adding their own %
	s/\02f/$file/g;			# %f is the full path name
	s/\02D/&dir($file)/ge;	# %D is the dir name
	s/\02F/&base($file)/ge;	# %F is the base name
	s/\02p/$$/g;			# %p is the process's pid
	s/\02/%/g;				# All other % kept as-is
	s/\01/%/g;				# Restore escaped % signs
	$_;
}

# Return file basename (last path component)
sub base {
	my ($file) = @_;
	my ($base) = $file =~ m|^.*/(.*)|;
	return ($base eq '') ? $file : $base;
}

# Return dirname
sub dir {
	my ($file) = @_;
	my ($dir) = $file =~ m|^(.*)/.*|;
	return ($dir eq '') ? '.' : $dir;
}

#
# _acs_lock			-- private
#
# Internal locking routine.
#
# If $try is true, don't wait if the file is already locked.
# Returns true if the file was locked.
#
sub _acs_lock {		## private
	my $self = shift;
	my ($file, $format, $try) = @_;
	my $max = $self->max;
	my $delay = $self->delay;
	my $stamp = $$;

	# For NFS, we need something more unique than the process's PID
	$stamp .= ':' . hostname if $self->nfs;

	# Compute locking file name -- hardwired default format is "%f.lock"
	my $lockfile = $file . $self->ext;
	$format = $self->format unless defined $format;
	$lockfile = $self->lockfile($file, $format) if defined $format;

	# Detect stale locks or break lock if held for too long
	$self->_acs_stale($file, $lockfile) if $self->stale;
	$self->_acs_check($file, $lockfile) if $self->hold;

	my $waited = 0;					# Amount of time spent sleeping
	my $lastwarn = 0;				# Last time we warned them...
	my $warn = $self->warn;
	my ($wmin, $wafter, $wfunc);
	($wmin, $wafter, $wfunc) = 
		($self->wmin, $self->wafter, $self->wfunc) if $warn;
	my $locked = 0;
	my $mask = umask(0333);			# No write permission
	local *FILE;

	while ($max-- > 0) {
		if (-f $lockfile) {
			next unless $try;
			umask($mask);
			return 0;				# Already locked
		}

		# Attempt to create lock
		if (open(FILE, ">$lockfile")) {
			local $\ = undef;
			my $buf = "$stamp\n";
			if (!syswrite(FILE, $buf, length($buf))) {
				&$wfunc("writing to $lockfile: $!\n");
				close(FILE);
				if (!unlink($lockfile)) {
					&$wfunc("removing $lockfile: $!");
				}
				umask($mask);
				return 0;  # Couldn't write to file
			}
			close FILE;
			open(FILE, $lockfile);	# Check lock
			my $l;
			chop($l = <FILE>);
			$locked = $l eq $stamp;
			$l = <FILE>;			# Must be EOF
			$locked = 0 if defined $l; 
			close FILE;
			last if $locked;		# Lock seems to be ours
		} elsif ($try) {
			umask($mask);
			return 0;				# Already locked, or cannot create lock
		}
	} continue {
		sleep($delay);				# Busy: wait
		$waited += $delay;

		# Warn them once after $wmin seconds and then every $wafter seconds
		if (
			$warn &&
				((!$lastwarn && $waited > $wmin) ||
				($waited - $lastwarn) > $wafter)
		) {
			my $waiting  = $lastwarn ? 'still waiting' : 'waiting';
			my $after  = $lastwarn ? 'after' : 'since';
			my $s = $waited == 1 ? '' : 's';
			&$wfunc("$waiting for $file lock $after $waited second$s");
			$lastwarn = $waited;
		}

		# While we wait, existing lockfile may become stale or too old
		$self->_acs_stale($file, $lockfile) if $self->stale;
		$self->_acs_check($file, $lockfile) if $self->hold;
	}

	umask($mask);
	return $locked;
}

#
# ->_acs_unlock		-- private
#
# Unlock file. If lock format is specified, it must match the one used
# at lock time.
#
# Return true if file was indeed locked by us and is now properly unlocked.
#
sub _acs_unlock {	## private
	my $self = shift;
	my ($file, $format) = @_;		# Locked file, locking format
	my $stamp = $$;
	$stamp .= ':' . hostname if $self->nfs;

	# Compute locking file name -- hardwired default format is "%f.lock"
	my $lockfile = $file . $self->ext;
	$format = $self->format unless defined $format;
	$lockfile = $self->lockfile($file, $format) if defined $format;

	local *FILE;
	my $unlocked = 0;

	if (-f $lockfile) {
		open(FILE, $lockfile);
		my $l;
		chop($l = <FILE>);
		close FILE;
		if ($l eq $stamp) {			# Pid (plus hostname possibly) is OK
			$unlocked = 1;
			unless (unlink $lockfile) {
				$unlocked = 0;
				&{$self->efunc}("cannot unlock $file: $!");
			}
		} else {
			&{$self->efunc}("cannot unlock $file: lock not owned");
		}
	} else {
		&{$self->wfunc}("no lockfile found for $file");
	}

	return $unlocked;				# Did we successfully unlock?
}

#
# ->_acs_check
#
# Make sure lock lasts only for a reasonable time. If it has expired,
# then remove the lockfile.
#
# This is not enabled by default because there is a race condition between
# the time we stat the file and the time we unlink the lockfile.
#
sub _acs_check {
	my $self = shift;
	my ($file, $lockfile) = @_;

	my $mtime = (stat($lockfile))[9];
	return unless defined $mtime;	# Assume file does not exist
	my $hold = $self->hold;

	# If file too old to be considered stale?
	if ((time - $mtime) > $hold) {

		# RACE CONDITION -- shall we lock the lockfile?

		unless (unlink $lockfile) {
			&{$self->efunc}("cannot unlink $lockfile: $!");
			return;
		}

		if ($self->warn) {
			my $s = $hold == 1 ? '' : 's';
			&{$self->wfunc}("UNLOCKED $file (lock older than $hold second$s)");
		}
	}
}

#
# ->_acs_stale
#
# Detect stale locks and remove them. This works by sending a SIGZERO to
# the pid held in the lockfile. If configured for NFS, only processes
# on the same host than the one holding the lock will be able to perform
# the check.
#
# Stale lock detection is not enabled by default because there is a race
# condition between the time we check for the pid, and the time we unlink
# the lockfile: we could well be unlinking a new lockfile created inbetween.
#
sub _acs_stale {
	my $self = shift;
	my ($file, $lockfile) = @_;

	local *FILE;
	open(FILE, $lockfile) || return;
	my $stamp;
	chop($stamp = <FILE>);
	close FILE;

	my ($pid, $hostname);

	if ($self->nfs) {
		($pid, $hostname) = $stamp =~ /^(\d+):(\S+)/;
		my $local = hostname;
		return if $local ne $hostname;
		return if kill 0, $pid;
		$hostname = " on $hostname";
	} else {
		($pid) = $stamp =~ /^(\d+)$/;		# Untaint $pid for kill()
		$hostname = '';
		return if kill 0, $pid;
	}

	# RACE CONDITION -- shall we lock the lockfile?

	unless (unlink $lockfile) {
		&{$self->efunc}("cannot unlink stale $lockfile: $!");
		return;
	}

	&{$self->wfunc}("UNLOCKED $file (stale lock by PID $pid$hostname)");
}

1;

########################################################################

=head1 NAME

LockFile::Simple - simple file locking scheme

=head1 SYNOPSIS

 use LockFile::Simple qw(lock trylock unlock);

 # Simple locking using default settings
 lock("/some/file") || die "can't lock /some/file\n";
 warn "already locked\n" unless trylock("/some/file");
 unlock("/some/file");

 # Build customized locking manager object
 $lockmgr = LockFile::Simple->make(-format => '%f.lck',
	-max => 20, -delay => 1, -nfs => 1);

 $lockmgr->lock("/some/file") || die "can't lock /some/file\n";
 $lockmgr->trylock("/some/file");
 $lockmgr->unlock("/some/file");

 $lockmgr->configure(-nfs => 0);

 # Using lock handles
 my $lock = $lockmgr->lock("/some/file");
 $lock->release;

=head1 DESCRIPTION

This simple locking scheme is not based on any file locking system calls
such as C<flock()> or C<lockf()> but rather relies on basic file system
primitives and properties, such as the atomicity of the C<write()> system
call. It is not meant to be exempt from all race conditions, especially over
NFS. The algorithm used is described below in the B<ALGORITHM> section.

It is possible to customize the locking operations to attempt locking
once every 5 seconds for 30 times, or delete stale locks (files that are
deemed too ancient) before attempting the locking.

=head1 ALGORITHM

The locking alogrithm attempts to create a I<lockfile> using a temporarily
redefined I<umask> (leaving only read rights to prevent further create
operations). It then writes the process ID (PID) of the process and closes
the file. That file is then re-opened and read. If we are able to read the
same PID we wrote, and only that, we assume the locking is successful.

When locking over NFS, i.e. when the one of the potentially locking processes
could access the I<lockfile> via NFS, then writing the PID is not enough.
We also write the hostname where locking is attempted to ensure the data
are unique.

=head1 CUSTOMIZING

Customization is only possible by using the object-oriented interface,
since the configuration parameters are stored within the object. The
object creation routine C<make> can be given configuration parmeters in
the form a "hash table list", i.e. a list of key/value pairs. Those
parameters can later be changed via C<configure> by specifying a similar
list of key/value pairs.

To benefit from the bareword quoting Perl offers, all the parameters must
be prefixed with the C<-> (minus) sign, as in C<-format> for the I<format>
parameter..  However, when querying the object, the minus must be omitted,
as in C<$obj-E<gt>format>.

Here are the available configuration parmeters along with their meaning,
listed in alphabetical order:

=over 4

=item I<autoclean>

When true, all locks are remembered and pending ones are automatically
released when the process exits normally (i.e. whenever Perl calls the
END routines).

=item I<delay>

The amount of seconds to wait between locking attempts when the file appears
to be already locked. Default is 2 seconds.

=item I<efunc>

A function pointer to dereference when an error is to be reported. By default,
it redirects to the logerr() routine if you have Log::Agent installed,
to Perl's warn() function otherwise.

You may set it explicitly to C<\&LockFile::Simple::core_warn> to force the
use of Perl's warn() function, or to C<undef> to suppress logging.

=item I<ext>

The locking extension that must be added to the file path to be locked to
compute the I<lockfile> path. Default is C<.lock> (note that C<.> is part
of the extension and can therefore be changed). Ignored when I<format> is
also used.

=item I<format>

Using this parmeter supersedes the I<ext> parmeter. The formatting string
specified is run through a rudimentary macro expansion to derive the
I<lockfile> path from the file to be locked. The following macros are
available:

    %%	A real % sign
    %f	The full file path name
    %D	The directory where the file resides
    %F	The base name of the file
    %p	The process ID (PID)

The default is to use the locking extension, which itself is C<.lock>, so
it is as if the format used was C<%f.lock>, but one could imagine things
like C</var/run/%F.%p>, i.e. the I<lockfile> does not necessarily lie besides
the locked file (which could even be missing).

When locking, the locking format can be specified to supersede the object
configuration itself.

=item I<hold>

Maximum amount of seconds we may hold a lock. Past that amount of time,
an existing I<lockfile> is removed, being taken for a stale lock. Default
is 3600 seconds. Specifying 0 prevents any forced unlocking.

=item I<max>

Amount of times we retry locking when the file is busy, sleeping I<delay>
seconds between attempts. Defaults to 30.

=item I<nfs>

A boolean flag, false by default. Setting it to true means we could lock
over NFS and therefore the hostname must be included along with the process
ID in the stamp written to the lockfile.

=item I<stale>

A boolean flag, false by default. When set to true, we attempt to detect
stale locks and break them if necessary.

=item I<wafter>

Stands for I<warn after>. It is the number of seconds past the first
warning during locking time after which a new warning should be emitted.
See I<warn> and I<wmin> below. Default is 20.

=item I<warn>

A boolean flag, true by default. To suppress any warning, set it to false.

=item I<wfunc>

A function pointer to dereference when a warning is to be issued. By default,
it redirects to the logwarn() routine if you have Log::Agent installed,
to Perl's warn() function otherwise.

You may set it explicitly to C<\&LockFile::Simple::core_warn> to force the
use of Perl's warn() function, or to C<undef> to suppress logging.

=item I<wmin>

The minimal amount of time when waiting for a lock after which a first
warning must be emitted, if I<warn> is true. After that, a warning will
be emitted every I<wafter> seconds. Defaults to 15.

=back

Each of those configuration attributes can be queried on the object directly:

    $obj = LockFile::Simple->make(-nfs => 1);
    $on_nfs = $obj->nfs;

Those are pure query routines, i.e. you cannot say:

    $obj->nfs(0);                  # WRONG
    $obj->configure(-nfs => 0);    # Right

to turn of the NFS attribute. That is because my OO background chokes
at having querying functions with side effects.

=head1 INTERFACE

The OO interface documented below specifies the signature and the
semantics of the operations. Only the C<lock>, C<trylock> and
C<unlock> operation can be imported and used via a non-OO interface,
with the exact same signature nonetheless.

The interface contains all the attribute querying routines, one for
each configuration parmeter documented in the B<CUSTOMIZING> section
above, plus, in alphabetical order:

=over 4

=item configure(I<-key =E<gt> value, -key2 =E<gt> value2, ...>)

Change the specified configuration parameters and silently ignore
the invalid ones.

=item lock(I<file>, I<format>)

Attempt to lock the file, using the optional locking I<format> if
specified, otherwise using the default I<format> scheme configured
in the object, or by simply appending the I<ext> extension to the file.

If the file is already locked, sleep I<delay> seconds before retrying,
repeating try/sleep at most I<max> times. If warning is configured,
a first warning is emitted after waiting for I<wmin> seconds, and
then once every I<wafter> seconds, via  the I<wfunc> routine.

Before the first attempt, and if I<hold> is non-zero, any existing
I<lockfile> is checked for being too old, and it is removed if found
to be stale. A warning is emitted via the I<wfunc> routine in that
case, if allowed.

Likewise, if I<stale> is non-zero, a check is made to see whether
any locking process is still around (only if the lock holder is on the
same machine when NFS locking is configured). Should the locking
process be dead, the I<lockfile> is declared stale and removed.

Returns a lock handle if the file has been successfully locked, which
does not necessarily needs to be kept around. For instance:

    $obj->lock('ppp', '/var/run/ppp.%p');
    <do some work>
    $obj->unlock('ppp');

or, using OO programming:

    my $lock = $obj->lock('ppp', '/var/run/ppp.%p') ||;
        die "Can't lock for ppp\n";
    <do some work>
    $lock->relase;   # The only method defined for a lock handle

i.e. you don't even have to know which file was locked to release it, since
there is a lock handle right there that knows enough about the lock parameters.

=item lockfile(I<file>, I<format>)

Simply compute the path of the I<lockfile> that would be used by the
I<lock> procedure if it were passed the same parameters.

=item make(I<-key =E<gt> value, -key2 =E<gt> value2, ...>)

The creation routine for the simple lock object. Returns a blessed hash
reference.

=item trylock(I<file>, I<format>)

Same as I<lock> except that it immediately returns false and does not
sleep if the to-be-locked file is busy, i.e. already locked. Any
stale locking file is removed, as I<lock> would do anyway.

Returns a lock hande if the file has been successfully locked.

=item unlock(I<file>)

Unlock the I<file>.

=back

=head1 BUGS

The algorithm is not bullet proof.  It's only reasonably safe.  Don't bet
the integrity of a mission-critical database on it though.

The sysopen() call should probably be used with the C<O_EXCL|O_CREAT> flags
to be on the safer side. Still, over NFS, this is not an atomic operation
anyway.

B<BEWARE>: there is a race condition between the time we decide a lock is
stale or too old and the time we unlink it. Don't use C<-stale> and set
C<-hold> to 0 if you can't bear with that idea, but recall that this race
only happens when something is already wrong. That does not make it right,
nonetheless. ;-)

=head1 AUTHOR

Raphael Manfredi F<E<lt>Raphael_Manfredi@pobox.comE<gt>>

=head1 SEE ALSO

File::Flock(3).

=cut