ЭЛЕКТРОННАЯ БИБЛИОТЕКА КОАПП |
Сборники Художественной, Технической, Справочной, Английской, Нормативной, Исторической, и др. литературы. |
7.21. Program: netlockWhen locking files, we recommend that you use The following program and module provide a basic implementation of a file locking mechanism. Unlike a normal 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.8, because you can lock the filename even though the file that has that name changes. The Set the 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, Packages, Libraries, and Modules. Example 7.10: File::LockDirpackage 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; use vars qw(@ISA @EXPORT); @ISA = qw(Exporter); @EXPORT = qw(nflock nunflock); use vars qw($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; local *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); return rmdir($lockname); } } 1; |