05/12/14 10:14:13
>>848-862
色々とご指摘ありがとうございます。ロックファイルをunlinkす
ると、close前にロックファイルがopen(作成)できてしまう問題を
回避する為にunlinkしない事にしました。
しかし、それだと*.lckが沢山できてしまうので、filelockディレ
クトリを作ってその中に作る事にしました。同様に書き込み用の
テンポラリファイルもその中に作るようにしたので、今までの
*.lckや*.tmpファイル名が使えなかったり拡張子だけが違うファ
イルが扱えない問題も無くなりました。
その代わり、各ディレクトリにfilelockという名前のディレクト
リができます。以下にソースを晒します。
sub open {
my ( $filename ) = @_;
my ( $handle, $mode );
if( $filename =~ /^>.*/ ) { $filename =~ s/^>(.*)/$1/; $mode = 2 }
elsif( $filename =~ /^<.*/ ) { $filename =~ s/^<(.*)/$1/; $mode = 1 }
else { return undef; }
if( $mode == 1 && !( -e $filename )) { return undef; }
$filename =~ /(.*)(\\|\/)(.*)/;
if(! -d "$1$2filelock") {
mkdir("$1$2filelock", 0755);
mkdir("$1$2filelock/tmp", 0755);
}
if( !$_FileList{$filename} ) {
$filename =~ /(.*)(\\|\/)(.*)/;
my $lockfile = $3 eq '' ? "$1$2filelock/$filename" : "$1$2filelock/$3";
if( !open( $handle, ">$lockfile" )) { die "file open error" }
my $count = 0;
while( !flock( $handle, ( 2 | 4 ))) {