sub getNewCounter # --------------------------------------------------------------- # Reads and incremements the counter value. Implementation based # on wisdom gained from perlmonks.org and the Perl Cookbook. # --------------------------------------------------------------- { my( $datafile ) = @_; my( $lockfile ); # Determine the name of the lock file $_ = $datafile; s/\.dat/\.lck/; $lockfile = $_; # The idea here is to wait up to ten seconds to gain access to # the lock file. If that fails, well, try again later. my( $retries ) = 10; open( LOCK, "$lockfile" ) or die "Cannot open lock file for reading. $!"; while ( $retries ) { if ( flock( LOCK, LOCK_EX | LOCK_NB ) ) # if Fcntl isn't available (it should be), try 2 | 4. { last; } else { $retries--; sleep( 1 ) ; } } # How did we get out of that loop? If we failed to flock, then flee unless ( $retries ) { die "Cannot lock counter for reading. $!"; } # Okay, we're assuming here... open( FILE, "+< $datafile" ) or die "Can't open data file for reading. $!"; my( $countval ) = ; seek( FILE, 0, 0 ) or die "Can't reset data file for writing. $!"; truncate( FILE, 0 ) or die "Can't clear data file for writing. $!"; print FILE ++$countval; close( FILE ) or die "Cannot close counter after writing. $!"; close( LOCK ) or die "Cannot close lock file. $!"; return( $countval ); }