لطفا منتظر باشید ...
 |  |
7.24. Program: netlock
When locking files, we recommend that
you use flock when possible. However, on some
systems, flock's locking strategy is not reliable.
For example, perhaps the person who built Perl on your system
configured flock to use a version of file locking
that didn't even try to work over the Net, or you're on the
increasingly rare system where no flock emulation
exists at all.The following program and module provide a basic implementation of a
file locking mechanism. Unlike a normal flock,
with this module you lock file names, not file
descriptors.Thus, you can use it to lock directories, domain sockets, and other
non-regular files. You can even lock files that don't exist yet. It
uses a directory created at the same level in the directory structure
as the locked file, so you must be able to write to the enclosing
directory of the file you wish to lock. A sentinel file within the
lock directory contains the owner of the lock. This is also useful
with Recipe 7.15 because you can lock the
filename even though the file that has that name changes.The nflock function takes one or two arguments.
The first is the pathname to lock; the second is the optional amount
of time to wait for the lock. The function returns true if the lock
is granted, returns false if the timeout expired, and raises an
exception should various improbable events occur, such as being
unable to write the directory.Set the $File::LockDir::Debug variable to true to
make the module emit messages if it stalls waiting for a lock. If you
forget to free a lock and try to exit the program, the module will
remove them for you. This won't happen if your program is sent a
signal it doesn't trap.Example 7-9 shows a driver program to demonstrate the
File::LockDir module.
Example 7-9. drivelock
#!/usr/bin/perl -w
# drivelock - demo File::LockDir module
use strict;
use File::LockDir;
$SIG{INT} = sub { die "outta here\n" };
$File::LockDir::Debug = 1;
my $path = shift or die "usage: $0 <path>\n";
unless (nflock($path, 2)) {
die "couldn't lock $path in 2 seconds\n";
}
sleep 100;
nunflock($path);
The module itself is shown in Example 7-10. For more
on building your own modules, see Chapter 12.
Example 7-10. File::LockDir
package File::LockDir;
# module to provide very basic filename-level
# locks. No fancy systems calls. In theory,
# directory info is sync'd over NFS. Not
# stress tested.
use strict;
use Exporter;
our (@ISA, @EXPORT);
@ISA = qw(Exporter);
@EXPORT = qw(nflock nunflock);
our ($Debug, $Check);
$Debug ||= 0; # may be predefined
$Check ||= 5; # may be predefined
use Cwd;
use Fcntl;
use Sys::Hostname;
use File::Basename;
use File::stat;
use Carp;
my %Locked_Files = ( );
# usage: nflock(FILE; NAPTILL)
sub nflock($;$) {
my $pathname = shift;
my $naptime = shift || 0;
my $lockname = name2lock($pathname);
my $whosegot = "$lockname/owner";
my $start = time( );
my $missed = 0;
my $owner;
# if locking what I've already locked, return
if ($Locked_Files{$pathname}) {
carp "$pathname already locked";
return 1
}
if (!-w dirname($pathname)) {
croak "can't write to directory of $pathname";
}
while (1) {
last if mkdir($lockname, 0777);
confess "can't get $lockname: $!" if $missed++ > 10
&& !-d $lockname;
if ($Debug) {{
open($owner, "< $whosegot") || last; # exit "if"!
my $lockee = <$owner>;
chomp($lockee);
printf STDERR "%s $0\[$$]: lock on %s held by %s\n",
scalar(localtime), $pathname, $lockee;
close $owner;
}}
sleep $Check;
return if $naptime && time > $start+$naptime;
}
sysopen($owner, $whosegot, O_WRONLY|O_CREAT|O_EXCL)
or croak "can't create $whosegot: $!";
printf $owner "$0\[$$] on %s since %s\n",
hostname( ), scalar(localtime);
close($owner)
or croak "close $whosegot: $!";
$Locked_Files{$pathname}++;
return 1;
}
# free the locked file
sub nunflock($) {
my $pathname = shift;
my $lockname = name2lock($pathname);
my $whosegot = "$lockname/owner";
unlink($whosegot);
carp "releasing lock on $lockname" if $Debug;
delete $Locked_Files{$pathname};
return rmdir($lockname);
}
# helper function
sub name2lock($) {
my $pathname = shift;
my $dir = dirname($pathname);
my $file = basename($pathname);
$dir = getcwd( ) if $dir eq ".";
my $lockname = "$dir/$file.LOCKDIR";
return $lockname;
}
# anything forgotten?
END {
for my $pathname (keys %Locked_Files) {
my $lockname = name2lock($pathname);
my $whosegot = "$lockname/owner";
carp "releasing forgotten $lockname";
unlink($whosegot);
rmdir($lockname);
}
}
1;
|  | |
| 7.23. Reading an Entire Line Without Blocking |  | 7.25. Program: lockarea |
Copyright © 2003 O'Reilly & Associates. All rights reserved.
