1;# $Id$ 2;# 3;# @COPYRIGHT@ 4;# 5;# $Log: Simple.pm,v $ 6;# Revision 0.4 2007/09/28 19:22:05 jv 7;# Bump version. 8;# 9;# Revision 0.3 2007/09/28 19:19:41 jv 10;# Revision 0.2.1.5 2000/09/18 19:55:07 ram 11;# patch5: fixed computation of %F and %D when no '/' in file name 12;# patch5: fixed OO example of lock to emphasize check on returned value 13;# patch5: now warns when no lockfile is found during unlocking 14;# 15;# Revision 0.2.1.4 2000/08/15 18:41:43 ram 16;# patch4: updated version number, grrr... 17;# 18;# Revision 0.2.1.3 2000/08/15 18:37:37 ram 19;# patch3: fixed non-working "-wfunc => undef" due to misuse of defined() 20;# patch3: check for stale lock while we wait for it 21;# patch3: untaint pid before running kill() for -T scripts 22;# 23;# Revision 0.2.1.2 2000/03/02 22:35:02 ram 24;# patch2: allow "undef" in -efunc and -wfunc to suppress logging 25;# patch2: documented how to force warn() despite Log::Agent being there 26;# 27;# Revision 0.2.1.1 2000/01/04 21:18:10 ram 28;# patch1: logerr and logwarn are autoloaded, need to check something real 29;# patch1: forbid re-lock of a file we already locked 30;# patch1: force $\ to be undef prior to writing the PID to lockfile 31;# patch1: track where lock was issued in the code 32;# 33;# Revision 0.2.1.5 2000/09/18 19:55:07 ram 34;# patch5: fixed computation of %F and %D when no '/' in file name 35;# patch5: fixed OO example of lock to emphasize check on returned value 36;# patch5: now warns when no lockfile is found during unlocking 37;# 38;# Revision 0.2.1.4 2000/08/15 18:41:43 ram 39;# patch4: updated version number, grrr... 40;# 41;# Revision 0.2.1.3 2000/08/15 18:37:37 ram 42;# patch3: fixed non-working "-wfunc => undef" due to misuse of defined() 43;# patch3: check for stale lock while we wait for it 44;# patch3: untaint pid before running kill() for -T scripts 45;# 46;# Revision 0.2.1.2 2000/03/02 22:35:02 ram 47;# patch2: allow "undef" in -efunc and -wfunc to suppress logging 48;# patch2: documented how to force warn() despite Log::Agent being there 49;# 50;# Revision 0.2.1.1 2000/01/04 21:18:10 ram 51;# patch1: logerr and logwarn are autoloaded, need to check something real 52;# patch1: forbid re-lock of a file we already locked 53;# patch1: force $\ to be undef prior to writing the PID to lockfile 54;# patch1: track where lock was issued in the code 55;# 56;# Revision 0.2 1999/12/07 20:51:05 ram 57;# Baseline for 0.2 release. 58;# 59 60use strict; 61 62######################################################################## 63package LockFile::Simple; 64 65# 66# This package extracts the simple locking logic used by mailagent-3.0 67# into a standalone Perl module to be reused in other applications. 68# 69 70use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); 71 72use Sys::Hostname; 73require Exporter; 74require LockFile::Lock::Simple; 75eval "use Log::Agent"; 76 77@ISA = qw(Exporter); 78@EXPORT = (); 79@EXPORT_OK = qw(lock trylock unlock); 80$VERSION = '0.208'; 81 82my $LOCKER = undef; # Default locking object 83 84# 85# ->make 86# 87# Create a file locking object, responsible for holding the locking 88# parameters to be used by all the subsequent locks requested from 89# this locking object. 90# 91# Configuration attributes: 92# 93# autoclean keep track of locks and release pending one at END time 94# max max number of attempts 95# delay seconds to wait between attempts 96# format how to derive lockfile from file to be locked 97# hold max amount of seconds before breaking lock (0 for never) 98# ext lock extension 99# nfs true if lock must "work" on top of NFS 100# stale try to detect stale locks via SIGZERO and delete them 101# warn flag to turn warnings on 102# wmin warn once after that many waiting seconds 103# wafter warn every that many seconds after first warning 104# wfunc warning function to be called 105# efunc error function to be called 106# 107# Additional attributes: 108# 109# manager lock manager, used when autoclean 110# lock_by_file returns lock by filename 111# 112# The creation routine first and sole argument is a "hash table list" listing 113# all the configuration attributes. Missing attributes are given a default 114# value. A call to ->configure can alter the configuration parameters of 115# an existing object. 116# 117sub make { 118 my $self = bless {}, shift; 119 my (@hlist) = @_; 120 121 # Set configuration defaults, then override with user preferences 122 $self->{'max'} = 30; 123 $self->{'delay'} = 2; 124 $self->{'hold'} = 3600; 125 $self->{'ext'} = '.lock'; 126 $self->{'nfs'} = 0; 127 $self->{'stale'} = 0; 128 $self->{'warn'} = 1; 129 $self->{'wmin'} = 15; 130 $self->{'wafter'} = 20; 131 $self->{'autoclean'} = 0; 132 $self->{'lock_by_file'} = {}; 133 134 # The logxxx routines are autoloaded, so need to check for @EXPORT 135 $self->{'wfunc'} = @Log::Agent::EXPORT ? \&logwarn : \&core_warn; 136 $self->{'efunc'} = @Log::Agent::EXPORT ? \&logerr : \&core_warn; 137 138 $self->configure(@hlist); # Will init "manager" if necessary 139 return $self; 140} 141 142# 143# ->locker -- "once" function 144# 145# Compute the default locking object. 146# 147sub locker { 148 return $LOCKER || ($LOCKER = LockFile::Simple->make('-warn' => 1)); 149} 150 151# 152# ->configure 153# 154# Extract known configuration parameters from the specified hash list 155# and use their values to change the object's corresponding parameters. 156# 157# Parameters are specified as (-warn => 1, -ext => '.lock') for instance. 158# 159sub configure { 160 my $self = shift; 161 my (%hlist) = @_; 162 my @known = qw( 163 autoclean 164 max delay hold format ext nfs warn wfunc wmin wafter efunc stale 165 ); 166 167 foreach my $attr (@known) { 168 $self->{$attr} = $hlist{"-$attr"} if exists $hlist{"-$attr"}; 169 } 170 171 $self->{'wfunc'} = \&no_warn unless defined $self->{'wfunc'}; 172 $self->{'efunc'} = \&no_warn unless defined $self->{'efunc'}; 173 174 if ($self->autoclean) { 175 require LockFile::Manager; 176 # Created via "once" function 177 $self->{'manager'} = LockFile::Manager->manager( 178 $self->wfunc, $self->efunc); 179 } 180} 181 182# 183# Attribute access 184# 185 186sub max { $_[0]->{'max'} } 187sub delay { $_[0]->{'delay'} } 188sub format { $_[0]->{'format'} } 189sub hold { $_[0]->{'hold'} } 190sub nfs { $_[0]->{'nfs'} } 191sub stale { $_[0]->{'stale'} } 192sub ext { $_[0]->{'ext'} } 193sub warn { $_[0]->{'warn'} } 194sub wmin { $_[0]->{'wmin'} } 195sub wafter { $_[0]->{'wafter'} } 196sub wfunc { $_[0]->{'wfunc'} } 197sub efunc { $_[0]->{'efunc'} } 198sub autoclean { $_[0]->{'autoclean'} } 199sub lock_by_file { $_[0]->{'lock_by_file'} } 200sub manager { $_[0]->{'manager'} } 201 202# 203# Warning and error reporting -- Log::Agent used only when available 204# 205 206sub core_warn { CORE::warn(@_) } 207sub no_warn { return } 208 209# 210# ->lock 211# 212# Lock specified file, possibly using alternate file "format". 213# Returns whether file was locked or not at the end of the configured 214# blocking period by providing the LockFile::Lock instance if successful. 215# 216# For quick and dirty scripts wishing to use locks, create the locking 217# object if not invoked as a method, turning on warnings. 218# 219sub lock { 220 my $self = shift; 221 unless (ref $self) { # Not invoked as a method 222 unshift(@_, $self); 223 $self = locker(); 224 } 225 my ($file, $format) = @_; # File to be locked, lock format 226 return $self->take_lock($file, $format, 0); 227} 228 229# 230# ->trylock 231# 232# Attempt to lock specified file, possibly using alternate file "format". 233# If the file is already locked, don't block and return undef. The 234# LockFile::Lock instance is returned upon success. 235# 236# For quick and dirty scripts wishing to use locks, create the locking 237# object if not invoked as a method, turning on warnings. 238# 239sub trylock { 240 my $self = shift; 241 unless (ref $self) { # Not invoked as a method 242 unshift(@_, $self); 243 $self = locker(); 244 } 245 my ($file, $format) = @_; # File to be locked, lock format 246 return $self->take_lock($file, $format, 1); 247} 248 249# 250# ->take_lock 251# 252# Common code for ->lock and ->trylock. 253# Returns a LockFile::Lock object on success, undef on failure. 254# 255sub take_lock { 256 my $self = shift; 257 my ($file, $format, $tryonly) = @_; 258 259 # 260 # If lock was already taken by us, it's an error when $tryonly is 0. 261 # Otherwise, simply fail to get the lock. 262 # 263 264 my $lock = $self->lock_by_file->{$file}; 265 if (defined $lock) { 266 my $where = $lock->where; 267 &{$self->efunc}("file $file already locked at $where") unless $tryonly; 268 return undef; 269 } 270 271 my $locked = $self->_acs_lock($file, $format, $tryonly); 272 return undef unless $locked; 273 274 # 275 # Create LockFile::Lock object 276 # 277 278 my ($package, $filename, $line) = caller(1); 279 $lock = LockFile::Lock::Simple->make($self, $file, $format, 280 $filename, $line); 281 $self->manager->remember($lock) if $self->autoclean; 282 $self->lock_by_file->{$file} = $lock; 283 284 return $lock; 285} 286 287# 288# ->unlock 289# 290# Unlock file. 291# Returns true if file was unlocked. 292# 293sub unlock { 294 my $self = shift; 295 unless (ref $self) { # Not invoked as a method 296 unshift(@_, $self); 297 $self = locker(); 298 } 299 my ($file, $format) = @_; # File to be unlocked, lock format 300 301 if (defined $format) { 302 require Carp; 303 Carp::carp("2nd argument (format) is no longer needed nor used"); 304 } 305 306 # 307 # Retrieve LockFile::Lock object 308 # 309 310 my $lock = $self->lock_by_file->{$file}; 311 312 unless (defined $lock) { 313 &{$self->efunc}("file $file not currently locked"); 314 return undef; 315 } 316 317 return $self->release($lock); 318} 319 320# 321# ->release -- not exported (i.e. not documented) 322# 323# Same a unlock, but we're passed a LockFile::Lock object. 324# And we MUST be called as a method (usually via LockFile::Lock, not user code). 325# 326# Returns true if file was unlocked. 327# 328sub release { 329 my $self = shift; 330 my ($lock) = @_; 331 my $file = $lock->file; 332 my $format = $lock->format; 333 $self->manager->forget($lock) if $self->autoclean; 334 delete $self->lock_by_file->{$file}; 335 return $self->_acs_unlock($file, $format); 336} 337 338# 339# ->lockfile 340# 341# Return the name of the lockfile, given the file name to lock and the custom 342# string provided by the user. The following macros are substituted: 343# %D: the file dir name 344# %f: the file name (full path) 345# %F: the file base name (last path component) 346# %p: the process's pid 347# %%: a plain % character 348# 349sub lockfile { 350 my $self = shift; 351 my ($file, $format) = @_; 352 local $_ = defined($format) ? $format : $self->format; 353 s/%%/\01/g; # Protect double percent signs 354 s/%/\02/g; # Protect against substitutions adding their own % 355 s/\02f/$file/g; # %f is the full path name 356 s/\02D/&dir($file)/ge; # %D is the dir name 357 s/\02F/&base($file)/ge; # %F is the base name 358 s/\02p/$$/g; # %p is the process's pid 359 s/\02/%/g; # All other % kept as-is 360 s/\01/%/g; # Restore escaped % signs 361 $_; 362} 363 364# Return file basename (last path component) 365sub base { 366 my ($file) = @_; 367 my ($base) = $file =~ m|^.*/(.*)|; 368 return ($base eq '') ? $file : $base; 369} 370 371# Return dirname 372sub dir { 373 my ($file) = @_; 374 my ($dir) = $file =~ m|^(.*)/.*|; 375 return ($dir eq '') ? '.' : $dir; 376} 377 378# 379# _acs_lock -- private 380# 381# Internal locking routine. 382# 383# If $try is true, don't wait if the file is already locked. 384# Returns true if the file was locked. 385# 386sub _acs_lock { ## private 387 my $self = shift; 388 my ($file, $format, $try) = @_; 389 my $max = $self->max; 390 my $delay = $self->delay; 391 my $stamp = $$; 392 393 # For NFS, we need something more unique than the process's PID 394 $stamp .= ':' . hostname if $self->nfs; 395 396 # Compute locking file name -- hardwired default format is "%f.lock" 397 my $lockfile = $file . $self->ext; 398 $format = $self->format unless defined $format; 399 $lockfile = $self->lockfile($file, $format) if defined $format; 400 401 # Detect stale locks or break lock if held for too long 402 $self->_acs_stale($file, $lockfile) if $self->stale; 403 $self->_acs_check($file, $lockfile) if $self->hold; 404 405 my $waited = 0; # Amount of time spent sleeping 406 my $lastwarn = 0; # Last time we warned them... 407 my $warn = $self->warn; 408 my ($wmin, $wafter, $wfunc); 409 ($wmin, $wafter, $wfunc) = 410 ($self->wmin, $self->wafter, $self->wfunc) if $warn; 411 my $locked = 0; 412 my $mask = umask(0333); # No write permission 413 local *FILE; 414 415 while ($max-- > 0) { 416 if (-f $lockfile) { 417 next unless $try; 418 umask($mask); 419 return 0; # Already locked 420 } 421 422 # Attempt to create lock 423 if (open(FILE, ">$lockfile")) { 424 local $\ = undef; 425 print FILE "$stamp\n"; 426 close FILE; 427 open(FILE, $lockfile); # Check lock 428 my $l; 429 chop($l = <FILE>); 430 $locked = $l eq $stamp; 431 $l = <FILE>; # Must be EOF 432 $locked = 0 if defined $l; 433 close FILE; 434 last if $locked; # Lock seems to be ours 435 } elsif ($try) { 436 umask($mask); 437 return 0; # Already locked, or cannot create lock 438 } 439 } continue { 440 sleep($delay); # Busy: wait 441 $waited += $delay; 442 443 # Warn them once after $wmin seconds and then every $wafter seconds 444 if ( 445 $warn && 446 ((!$lastwarn && $waited > $wmin) || 447 ($waited - $lastwarn) > $wafter) 448 ) { 449 my $waiting = $lastwarn ? 'still waiting' : 'waiting'; 450 my $after = $lastwarn ? 'after' : 'since'; 451 my $s = $waited == 1 ? '' : 's'; 452 &$wfunc("$waiting for $file lock $after $waited second$s"); 453 $lastwarn = $waited; 454 } 455 456 # While we wait, existing lockfile may become stale or too old 457 $self->_acs_stale($file, $lockfile) if $self->stale; 458 $self->_acs_check($file, $lockfile) if $self->hold; 459 } 460 461 umask($mask); 462 return $locked; 463} 464 465# 466# ->_acs_unlock -- private 467# 468# Unlock file. If lock format is specified, it must match the one used 469# at lock time. 470# 471# Return true if file was indeed locked by us and is now properly unlocked. 472# 473sub _acs_unlock { ## private 474 my $self = shift; 475 my ($file, $format) = @_; # Locked file, locking format 476 my $stamp = $$; 477 $stamp .= ':' . hostname if $self->nfs; 478 479 # Compute locking file name -- hardwired default format is "%f.lock" 480 my $lockfile = $file . $self->ext; 481 $format = $self->format unless defined $format; 482 $lockfile = $self->lockfile($file, $format) if defined $format; 483 484 local *FILE; 485 my $unlocked = 0; 486 487 if (-f $lockfile) { 488 open(FILE, $lockfile); 489 my $l; 490 chop($l = <FILE>); 491 close FILE; 492 if ($l eq $stamp) { # Pid (plus hostname possibly) is OK 493 $unlocked = 1; 494 unless (unlink $lockfile) { 495 $unlocked = 0; 496 &{$self->efunc}("cannot unlock $file: $!"); 497 } 498 } else { 499 &{$self->efunc}("cannot unlock $file: lock not owned"); 500 } 501 } else { 502 &{$self->wfunc}("no lockfile found for $file"); 503 } 504 505 return $unlocked; # Did we successfully unlock? 506} 507 508# 509# ->_acs_check 510# 511# Make sure lock lasts only for a reasonable time. If it has expired, 512# then remove the lockfile. 513# 514# This is not enabled by default because there is a race condition between 515# the time we stat the file and the time we unlink the lockfile. 516# 517sub _acs_check { 518 my $self = shift; 519 my ($file, $lockfile) = @_; 520 521 my $mtime = (stat($lockfile))[9]; 522 return unless defined $mtime; # Assume file does not exist 523 my $hold = $self->hold; 524 525 # If file too old to be considered stale? 526 if ((time - $mtime) > $hold) { 527 528 # RACE CONDITION -- shall we lock the lockfile? 529 530 unless (unlink $lockfile) { 531 &{$self->efunc}("cannot unlink $lockfile: $!"); 532 return; 533 } 534 535 if ($self->warn) { 536 my $s = $hold == 1 ? '' : 's'; 537 &{$self->wfunc}("UNLOCKED $file (lock older than $hold second$s)"); 538 } 539 } 540} 541 542# 543# ->_acs_stale 544# 545# Detect stale locks and remove them. This works by sending a SIGZERO to 546# the pid held in the lockfile. If configured for NFS, only processes 547# on the same host than the one holding the lock will be able to perform 548# the check. 549# 550# Stale lock detection is not enabled by default because there is a race 551# condition between the time we check for the pid, and the time we unlink 552# the lockfile: we could well be unlinking a new lockfile created inbetween. 553# 554sub _acs_stale { 555 my $self = shift; 556 my ($file, $lockfile) = @_; 557 558 local *FILE; 559 open(FILE, $lockfile) || return; 560 my $stamp; 561 chop($stamp = <FILE>); 562 close FILE; 563 564 my ($pid, $hostname); 565 566 if ($self->nfs) { 567 ($pid, $hostname) = $stamp =~ /^(\d+):(\S+)/; 568 my $local = hostname; 569 return if $local ne $hostname; 570 return if kill 0, $pid; 571 $hostname = " on $hostname"; 572 } else { 573 ($pid) = $stamp =~ /^(\d+)$/; # Untaint $pid for kill() 574 $hostname = ''; 575 return if kill 0, $pid; 576 } 577 578 # RACE CONDITION -- shall we lock the lockfile? 579 580 unless (unlink $lockfile) { 581 &{$self->efunc}("cannot unlink stale $lockfile: $!"); 582 return; 583 } 584 585 &{$self->wfunc}("UNLOCKED $file (stale lock by PID $pid$hostname)"); 586} 587 5881; 589 590######################################################################## 591 592=head1 NAME 593 594LockFile::Simple - simple file locking scheme 595 596=head1 SYNOPSIS 597 598 use LockFile::Simple qw(lock trylock unlock); 599 600 # Simple locking using default settings 601 lock("/some/file") || die "can't lock /some/file\n"; 602 warn "already locked\n" unless trylock("/some/file"); 603 unlock("/some/file"); 604 605 # Build customized locking manager object 606 $lockmgr = LockFile::Simple->make(-format => '%f.lck', 607 -max => 20, -delay => 1, -nfs => 1); 608 609 $lockmgr->lock("/some/file") || die "can't lock /some/file\n"; 610 $lockmgr->trylock("/some/file"); 611 $lockmgr->unlock("/some/file"); 612 613 $lockmgr->configure(-nfs => 0); 614 615 # Using lock handles 616 my $lock = $lockmgr->lock("/some/file"); 617 $lock->release; 618 619=head1 DESCRIPTION 620 621This simple locking scheme is not based on any file locking system calls 622such as C<flock()> or C<lockf()> but rather relies on basic file system 623primitives and properties, such as the atomicity of the C<write()> system 624call. It is not meant to be exempt from all race conditions, especially over 625NFS. The algorithm used is described below in the B<ALGORITHM> section. 626 627It is possible to customize the locking operations to attempt locking 628once every 5 seconds for 30 times, or delete stale locks (files that are 629deemed too ancient) before attempting the locking. 630 631=head1 ALGORITHM 632 633The locking alogrithm attempts to create a I<lockfile> using a temporarily 634redefined I<umask> (leaving only read rights to prevent further create 635operations). It then writes the process ID (PID) of the process and closes 636the file. That file is then re-opened and read. If we are able to read the 637same PID we wrote, and only that, we assume the locking is successful. 638 639When locking over NFS, i.e. when the one of the potentially locking processes 640could access the I<lockfile> via NFS, then writing the PID is not enough. 641We also write the hostname where locking is attempted to ensure the data 642are unique. 643 644=head1 CUSTOMIZING 645 646Customization is only possible by using the object-oriented interface, 647since the configuration parameters are stored within the object. The 648object creation routine C<make> can be given configuration parmeters in 649the form a "hash table list", i.e. a list of key/value pairs. Those 650parameters can later be changed via C<configure> by specifying a similar 651list of key/value pairs. 652 653To benefit from the bareword quoting Perl offers, all the parameters must 654be prefixed with the C<-> (minus) sign, as in C<-format> for the I<format> 655parameter.. However, when querying the object, the minus must be omitted, 656as in C<$obj-E<gt>format>. 657 658Here are the available configuration parmeters along with their meaning, 659listed in alphabetical order: 660 661=over 4 662 663=item I<autoclean> 664 665When true, all locks are remembered and pending ones are automatically 666released when the process exits normally (i.e. whenever Perl calls the 667END routines). 668 669=item I<delay> 670 671The amount of seconds to wait between locking attempts when the file appears 672to be already locked. Default is 2 seconds. 673 674=item I<efunc> 675 676A function pointer to dereference when an error is to be reported. By default, 677it redirects to the logerr() routine if you have Log::Agent installed, 678to Perl's warn() function otherwise. 679 680You may set it explicitely to C<\&LockFile::Simple::core_warn> to force the 681use of Perl's warn() function, or to C<undef> to suppress logging. 682 683=item I<ext> 684 685The locking extension that must be added to the file path to be locked to 686compute the I<lockfile> path. Default is C<.lock> (note that C<.> is part 687of the extension and can therefore be changed). Ignored when I<format> is 688also used. 689 690=item I<format> 691 692Using this parmeter supersedes the I<ext> parmeter. The formatting string 693specified is run through a rudimentary macro expansion to derive the 694I<lockfile> path from the file to be locked. The following macros are 695available: 696 697 %% A real % sign 698 %f The full file path name 699 %D The directory where the file resides 700 %F The base name of the file 701 %p The process ID (PID) 702 703The default is to use the locking extension, which itself is C<.lock>, so 704it is as if the format used was C<%f.lock>, but one could imagine things 705like C</var/run/%F.%p>, i.e. the I<lockfile> does not necessarily lie besides 706the locked file (which could even be missing). 707 708When locking, the locking format can be specified to supersede the object 709configuration itself. 710 711=item I<hold> 712 713Maximum amount of seconds we may hold a lock. Past that amount of time, 714an existing I<lockfile> is removed, being taken for a stale lock. Default 715is 3600 seconds. Specifying 0 prevents any forced unlocking. 716 717=item I<max> 718 719Amount of times we retry locking when the file is busy, sleeping I<delay> 720seconds between attempts. Defaults to 30. 721 722=item I<nfs> 723 724A boolean flag, false by default. Setting it to true means we could lock 725over NFS and therefore the hostname must be included along with the process 726ID in the stamp written to the lockfile. 727 728=item I<stale> 729 730A boolean flag, false by default. When set to true, we attempt to detect 731stale locks and break them if necessary. 732 733=item I<wafter> 734 735Stands for I<warn after>. It is the number of seconds past the first 736warning during locking time after which a new warning should be emitted. 737See I<warn> and I<wmin> below. Default is 20. 738 739=item I<warn> 740 741A boolean flag, true by default. To suppress any warning, set it to false. 742 743=item I<wfunc> 744 745A function pointer to dereference when a warning is to be issued. By default, 746it redirects to the logwarn() routine if you have Log::Agent installed, 747to Perl's warn() function otherwise. 748 749You may set it explicitely to C<\&LockFile::Simple::core_warn> to force the 750use of Perl's warn() function, or to C<undef> to suppress logging. 751 752=item I<wmin> 753 754The minimal amount of time when waiting for a lock after which a first 755warning must be emitted, if I<warn> is true. After that, a warning will 756be emitted every I<wafter> seconds. Defaults to 15. 757 758=back 759 760Each of those configuration attributes can be queried on the object directly: 761 762 $obj = LockFile::Simple->make(-nfs => 1); 763 $on_nfs = $obj->nfs; 764 765Those are pure query routines, i.e. you cannot say: 766 767 $obj->nfs(0); # WRONG 768 $obj->configure(-nfs => 0); # Right 769 770to turn of the NFS attribute. That is because my OO background chokes 771at having querying functions with side effects. 772 773=head1 INTERFACE 774 775The OO interface documented below specifies the signature and the 776semantics of the operations. Only the C<lock>, C<trylock> and 777C<unlock> operation can be imported and used via a non-OO interface, 778with the exact same signature nonetheless. 779 780The interface contains all the attribute querying routines, one for 781each configuration parmeter documented in the B<CUSTOMIZING> section 782above, plus, in alphabetical order: 783 784=over 4 785 786=item configure(I<-key =E<gt> value, -key2 =E<gt> value2, ...>) 787 788Change the specified configuration parameters and silently ignore 789the invalid ones. 790 791=item lock(I<file>, I<format>) 792 793Attempt to lock the file, using the optional locking I<format> if 794specified, otherwise using the default I<format> scheme configured 795in the object, or by simply appending the I<ext> extension to the file. 796 797If the file is already locked, sleep I<delay> seconds before retrying, 798repeating try/sleep at most I<max> times. If warning is configured, 799a first warning is emitted after waiting for I<wmin> seconds, and 800then once every I<wafter> seconds, via the I<wfunc> routine. 801 802Before the first attempt, and if I<hold> is non-zero, any existing 803I<lockfile> is checked for being too old, and it is removed if found 804to be stale. A warning is emitted via the I<wfunc> routine in that 805case, if allowed. 806 807Likewise, if I<stale> is non-zero, a check is made to see whether 808any locking process is still around (only if the lock holder is on the 809same machine when NFS locking is configured). Should the locking 810process be dead, the I<lockfile> is declared stale and removed. 811 812Returns a lock handle if the file has been successfully locked, which 813does not necessarily needs to be kept around. For instance: 814 815 $obj->lock('ppp', '/var/run/ppp.%p'); 816 <do some work> 817 $obj->unlock('ppp'); 818 819or, using OO programming: 820 821 my $lock = $obj->lock('ppp', '/var/run/ppp.%p') ||; 822 die "Can't lock for ppp\n"; 823 <do some work> 824 $lock->relase; # The only method defined for a lock handle 825 826i.e. you don't even have to know which file was locked to release it, since 827there is a lock handle right there that knows enough about the lock parameters. 828 829=item lockfile(I<file>, I<format>) 830 831Simply compute the path of the I<lockfile> that would be used by the 832I<lock> procedure if it were passed the same parameters. 833 834=item make(I<-key =E<gt> value, -key2 =E<gt> value2, ...>) 835 836The creation routine for the simple lock object. Returns a blessed hash 837reference. 838 839=item trylock(I<file>, I<format>) 840 841Same as I<lock> except that it immediately returns false and does not 842sleep if the to-be-locked file is busy, i.e. already locked. Any 843stale locking file is removed, as I<lock> would do anyway. 844 845Returns a lock hande if the file has been successfully locked. 846 847=item unlock(I<file>) 848 849Unlock the I<file>. 850 851=back 852 853=head1 BUGS 854 855The algorithm is not bullet proof. It's only reasonably safe. Don't bet 856the integrity of a mission-critical database on it though. 857 858The sysopen() call should probably be used with the C<O_EXCL|O_CREAT> flags 859to be on the safer side. Still, over NFS, this is not an atomic operation 860anyway. 861 862B<BEWARE>: there is a race condition between the time we decide a lock is 863stale or too old and the time we unlink it. Don't use C<-stale> and set 864C<-hold> to 0 if you can't bear with that idea, but recall that this race 865only happens when something is already wrong. That does not make it right, 866nonetheless. ;-) 867 868=head1 AUTHOR 869 870Raphael Manfredi F<E<lt>Raphael_Manfredi@pobox.comE<gt>> 871 872=head1 SEE ALSO 873 874File::Flock(3). 875 876=cut 877 878