ファイルのロック／アンロック
 
アクセスカウンタなどのプログラムでは、複数の人が同時にアクセスする可能性があり、同一ファイルを同時に扱うことになり、正しいファイル操作ができなくなります。
このような場合にはファイルをロックして、正しい順番でファイル操作できるようにします。

システム関数 flock が使える場合は、利用することにします（$useflock = 1 にする）。
flock() が利用しない（できない）場合は、ファイル名の前に $LPrefix で定義された文字列 （既定値は 'L-'）付加したファイル名をロックファイルとし、このファイルが存在するか、しないかをロックされている、されていないの判断とします。つまりロックするときにファイルを作成し、アンロックするときに削除します。ロックファイルをオープンするときのファイルハンドルはファイル名の文字列とします。
ロックしようとするときに、すでに他からロックされている場合は、$RetryNum 回数に達するまで $Interval 秒間隔でリトライします。


[サンプルプログラムの実行]
 
 
次のサブルーチンは再利用可能なので util.pl に入れておきます。 
# ロック関連の設定値
$RetryNum = 100;                        # リトライ回数
$Interval = 0.1;                # リトライのインターバル
$EX_LOCK = 2;                   # 排他ロック
$UN_LOCK = 8;                   # ロック解除
$LOCKTYPE = $EX_LOCK;   # ロックタイプは排他ロック
$useflock = 0;                  # flock()を使う場合は1にする
$LPrefix = 'L-';                # ロックファイルのプリフィクス
#
# lock(lfh, lockfile)
# <IN>  lfh: ロックファイルのハンドル（openLockで指定されたファイル名
#       に等しい。
#       lockfile: ロックファイル名
# <OUT> true: 成功  false: 失敗
#
sub lock($$)
{
        my($lfh, $lockfile) = @_;

        if ($useflock) {                # flock()を使う
                flock($lfh, $LOCKTYPE);
                return 1;
        }
        else {
                my($retry) = $RetryNum;
                while (-f $lockfile) {
                        select(undef, undef, undef, $Interval);
                        return undef if (--$retry <= 0);
                }
                return open($lfh, ">$lockfile");
        }
}


#
# unlock(lfh, lockfile)
# <IN>  lfh: ロックファイルのハンドル（openLockで指定されたファイル名
#       に等しい。
#       lockfile: ロックファイル名
# <OUT> なし
#
sub unlock ($$)
{
        my($lfh, $lockfile) = @_;

        if ($useflock) {                # flock()を使う
                flock($lfh, $UN_LOCK);
        }
        else {
                close($lfh);
                unlink($lockfile);
        }
}


#
# openLock(fh, modefile)
# <IN>  fh: ハンドル
#       modefile: モードを含むファイル名
# <OUT> true or false
#
sub openLock(*$)
{
        my($fh, $modefile) = @_;
        my($lockf);

        ($mode, $file) = ($modefile =~ /^(\+?(?:<|>>?)\s*?)(.+)$/);
        if ($file =~ /(\/|\\)/) {
                ($path, $filename) = ($file =~ /^(.*[\/|\\])(.+)$/);
        }
        else {
                $path = '';
                $filename = $file;
        }

        return undef unless $filename;
        $lockf = $path.$LPrefix."$filename";    # ロックファイル名
        lock($filename, $lockf) or return undef;

        open($fh, $modefile)
                or unlock($filename, $lockf), return undef;

        return 1;
}

#
# closeUnlock
# <IN>  fh: ハンドル
#       modefile: モードを含むファイル名
# <OUT> なし
#
sub closeUnlock(*$)
{
        my($fh, $file) = @_;

        if ($file =~ /(\/|\\)/) {
                ($path, $filename) = ($file =~ /^(.*[\/|\\])(.+)$/);
        }
        else {
                $path = '';
                $filename = $file;
        }
        my($lockfile) = $path.'L-'."$filename"; # ロックファイル名
        unlock($filename, $lockfile);

        close($fh);
}

 
lock.cgi 
#!/usr/bin/perl
#
# lock.cgi
#
# (C)1999 Kaoru Fujita
#
use lib ('./lib');
require 'util.pl';

#
# 定数
#
$Title = '外部ファイルの入出力サンプル';
$loc = './tmp';
$file = $loc.'/'."testlock";
$CharSet = 'Shift_JIS';

openLock(FH, ">$file") or
        exitError("ファイル $file がオープンできません。");

print FH "ファイル $file をオープンしてロックできました。\n";

closeUnlock(FH);

print <<END_OF_HTML;
Content-type: text/html

<HTML>
<HEAD>
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=$CharSet">
<TITLE>$Title</TITLE>
</HEAD>
<BODY>
ファイル $file をオープンしてロックできました。
</BODY>
</HTML>
END_OF_HTML

exit(0);

#--End of lock.cgi