ch07_22.htm
来自「By Tom Christiansen and Nathan Torkingto」· HTM 代码 · 共 441 行
HTM
441 行
<HTML><HEAD><TITLE>Recipe 7.21. Program: netlock (Perl Cookbook)</TITLE><METANAME="DC.title"CONTENT="Perl Cookbook"><METANAME="DC.creator"CONTENT="Tom Christiansen & Nathan Torkington"><METANAME="DC.publisher"CONTENT="O'Reilly & Associates, Inc."><METANAME="DC.date"CONTENT="1999-07-02T01:37:37Z"><METANAME="DC.type"CONTENT="Text.Monograph"><METANAME="DC.format"CONTENT="text/html"SCHEME="MIME"><METANAME="DC.source"CONTENT="1-56592-243-3"SCHEME="ISBN"><METANAME="DC.language"CONTENT="en-US"><METANAME="generator"CONTENT="Jade 1.1/O'Reilly DocBook 3.0 to HTML 4.0"><LINKREV="made"HREF="mailto:online-books@oreilly.com"TITLE="Online Books Comments"><LINKREL="up"HREF="ch07_01.htm"TITLE="7. File Access"><LINKREL="prev"HREF="ch07_21.htm"TITLE="7.20. Copying Filehandles"><LINKREL="next"HREF="ch07_23.htm"TITLE="7.22. Program: lockarea"></HEAD><BODYBGCOLOR="#FFFFFF"><img alt="Book Home" border="0" src="gifs/smbanner.gif" usemap="#banner-map" /><map name="banner-map"><area shape="rect" coords="1,-2,616,66" href="index.htm" alt="Perl Cookbook"><area shape="rect" coords="629,-11,726,25" href="jobjects/fsearch.htm" alt="Search this book" /></map><div class="navbar"><p><TABLEWIDTH="684"BORDER="0"CELLSPACING="0"CELLPADDING="0"><TR><TDALIGN="LEFT"VALIGN="TOP"WIDTH="228"><ACLASS="sect1"HREF="ch07_21.htm"TITLE="7.20. Copying Filehandles"><IMGSRC="../gifs/txtpreva.gif"ALT="Previous: 7.20. Copying Filehandles"BORDER="0"></A></TD><TDALIGN="CENTER"VALIGN="TOP"WIDTH="228"><B><FONTFACE="ARIEL,HELVETICA,HELV,SANSERIF"SIZE="-1"><ACLASS="chapter"REL="up"HREF="ch07_01.htm"TITLE="7. File Access"></A></FONT></B></TD><TDALIGN="RIGHT"VALIGN="TOP"WIDTH="228"><ACLASS="sect1"HREF="ch07_23.htm"TITLE="7.22. Program: lockarea"><IMGSRC="../gifs/txtnexta.gif"ALT="Next: 7.22. Program: lockarea"BORDER="0"></A></TD></TR></TABLE></DIV><DIVCLASS="sect1"><H2CLASS="sect1"><ACLASS="title"NAME="ch07-27900">7.21. Program: netlock</A></H2><PCLASS="para"><ACLASS="indexterm"NAME="ch07-idx-1000009802-0"></A><ACLASS="indexterm"NAME="ch07-idx-1000009802-1"></A><ACLASS="indexterm"NAME="ch07-idx-1000009802-2"></A><ACLASS="indexterm"NAME="ch07-idx-1000009802-3"></A>When locking files, we recommend that you use <CODECLASS="literal">flock</CODE><ACLASS="indexterm"NAME="ch07-idx-1000009809-0"></A> when possible. However, on some systems, <CODECLASS="literal">flock</CODE>'s locking strategy is not reliable. For example, the person who built Perl on your system configured <CODECLASS="literal">flock</CODE> 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 <CODECLASS="literal">flock</CODE> emulation exists at all.</P><PCLASS="para">The following program and module provide a basic implementation of a file locking mechanism. Unlike a normal <CODECLASS="literal">flock</CODE>, with this module you lock file <EMCLASS="emphasis">names</EM>, not file descriptors.</P><PCLASS="para">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 <ACLASS="xref"HREF="ch07_09.htm"TITLE="Modifying a File in Place with Temporary File">Recipe 7.8</A>, because you can lock the filename even though the file that has that name changes.</P><PCLASS="para">The <CODECLASS="literal">nflock</CODE> 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, false if the timeout expired, and raises an exception should various improbable events occur, like being unable to write the directory.</P><PCLASS="para">Set the <CODECLASS="literal">$File::LockDir::Debug</CODE> 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.</P><PCLASS="para"><ACLASS="xref"HREF="ch07_22.htm#ch07-24667"TITLE="drivelock">Example 7.9</A> shows a driver program to demonstrate the <ACLASS="indexterm"NAME="ch07-idx-1000011418-0"></A>File::LockDir module.</P><DIVCLASS="example"><H4CLASS="example"><ACLASS="title"NAME="ch07-24667">Example 7.9: drivelock</A></H4><PRECLASS="programlisting">#!/usr/bin/perl -w# <ACLASS="indexterm"NAME="ch07-idx-1000011430-0"></A>drivelock - demo File::LockDir moduleuse 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);</PRE></DIV><PCLASS="para">The module itself is shown in <ACLASS="xref"HREF="ch07_22.htm#ch07-18887"TITLE="File::LockDir">Example 7.10</A>. For more on building your own modules, see <ACLASS="xref"HREF="ch12_01.htm"TITLE="Packages, Libraries, and Modules">Chapter 12, <CITECLASS="chapter">Packages, Libraries, and Modules</CITE></A>.</P><DIVCLASS="example"><H4CLASS="example"><ACLASS="title"NAME="ch07-18887">Example 7.10: File::LockDir</A></H4><PRECLASS="programlisting">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;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 predefineduse 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 filesub 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 functionsub 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;<ACLASS="indexterm"NAME="ch07-idx-1000011670-0"></A><ACLASS="indexterm"NAME="ch07-idx-1000011670-1"></A><ACLASS="indexterm"NAME="ch07-idx-1000011670-2"></A><ACLASS="indexterm"NAME="ch07-idx-1000011670-3"></A></PRE></DIV></DIV><DIVCLASS="htmlnav"><P></P><HRALIGN="LEFT"WIDTH="684"TITLE="footer"><TABLEWIDTH="684"BORDER="0"CELLSPACING="0"CELLPADDING="0"><TR><TDALIGN="LEFT"VALIGN="TOP"WIDTH="228"><ACLASS="sect1"HREF="ch07_21.htm"TITLE="7.20. Copying Filehandles"><IMGSRC="../gifs/txtpreva.gif"ALT="Previous: 7.20. Copying Filehandles"BORDER="0"></A></TD><TDALIGN="CENTER"VALIGN="TOP"WIDTH="228"><ACLASS="book"HREF="index.htm"TITLE="Perl Cookbook"><IMGSRC="../gifs/txthome.gif"ALT="Perl Cookbook"BORDER="0"></A></TD><TDALIGN="RIGHT"VALIGN="TOP"WIDTH="228"><ACLASS="sect1"HREF="ch07_23.htm"TITLE="7.22. Program: lockarea"><IMGSRC="../gifs/txtnexta.gif"ALT="Next: 7.22. Program: lockarea"BORDER="0"></A></TD></TR><TR><TDALIGN="LEFT"VALIGN="TOP"WIDTH="228">7.20. Copying Filehandles</TD><TDALIGN="CENTER"VALIGN="TOP"WIDTH="228"><ACLASS="index"HREF="index/index.htm"TITLE="Book Index"><IMGSRC="../gifs/index.gif"ALT="Book Index"BORDER="0"></A></TD><TDALIGN="RIGHT"VALIGN="TOP"WIDTH="228">7.22. Program: lockarea</TD></TR></TABLE><HRALIGN="LEFT"WIDTH="684"TITLE="footer"><FONTSIZE="-1"></DIV<!-- LIBRARY NAV BAR --> <img src="../gifs/smnavbar.gif" usemap="#library-map" border="0" alt="Library Navigation Links"><p> <a href="copyrght.htm">Copyright © 2002</a> O'Reilly & Associates. All rights reserved.</font> </p> <map name="library-map"> <area shape="rect" coords="1,0,85,94" href="../index.htm"><area shape="rect" coords="86,1,178,103" href="../lwp/index.htm"><area shape="rect" coords="180,0,265,103" href="../lperl/index.htm"><area shape="rect" coords="267,0,353,105" href="../perlnut/index.htm"><area shape="rect" coords="354,1,446,115" href="../prog/index.htm"><area shape="rect" coords="448,0,526,132" href="../tk/index.htm"><area shape="rect" coords="528,1,615,119" href="../cookbook/index.htm"><area shape="rect" coords="617,0,690,135" href="../pxml/index.htm"></map> </BODY></HTML>⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?