 |
 |
 |
 |
 |
 |
 |
 |
 |
| |||||||
|
 | ||||||||||||||||||||||
|
 |
Click here to download plain text source code.
# subroutine name: inccounter # Increments content of counter and safely writes it back to file. # Returns incremented value in counter file # Creates file if it doesn't exist. # If error occurs, makes CGI process exit with error # # Global variables used: # $no_flock - disable flock or not sub inccounter { my ($datafile) = @_; my $num; # If OS (like Win95) desn't support flock, we have to # go unreliable and slow way and create "lock" file GetFileLock("$datafile.lock"); my $existed = -e $datafile; use Fcntl qw( O_RDWR O_WRONLY O_CREAT O_TRUNC ); if (sysopen(FH, "$datafile", &O_RDWR | &O_CREAT)) { #Exclusively lock unless ($no_flock) { flock(FH, 2) or die "Can't flock numfile: $!"; } $num = <FH> || 0; seek(FH, 0, 0) or die "Can't rewind numfile: $!"; truncate(FH, 0) or die "Can't truncate numfile: $!"; (print FH ++$num) or die "Can't write numfile: $!"; # Perl as of 5.004 automatically flushes before unlocking unless ($no_flock) { flock(FH, 8) or die "Can't flock numfile: $!"; } close (FH) or die "Can't close numfile: $!"; ReleaseFileLock("$datafile.lock"); } else { ReleaseFileLock("$datafile.lock"); die("Error in subroutine inccounter: Can't open $datafile. Reason: $!"); } return $num; } |
||||||||||||||||||||
| ||
|
Copyright © 1999-2007 Atomicsoft Ltd. All Rights Reserved. | |
