履歴を取りながらファイルを更新する


ファイルを全部書き換えてしまうような更新を Perl プログラムで行うとき、何代かの履歴を取りながらファイルを更新する方法を紹介。

my $path = “myfile.txt”; #保存ファイル名
my $contents = “…blabla…”; #今回保存する内容
my @updatefile = &update_file($path , $contents , 5); #4代前まで保存

$updatefile [0] or die $updatefile [1];

=pod
update_file($$;$)
安全にファイルを更新する。保存世代を指定できる。

引数:ファイルパス、保存内容、保存世代
戻り値:
成功の場合 1,ファイルパス
失敗の場合 0,エラーメッセージ
=cut
##############################################################
sub update_file{
my ($path, $contents, $generation) = @_;
my $try = 4;
$generation ||= 1; #保存しておく世代 1=そのファイルのみ

$path or return (0, “file not specified”);
-d $path and return (0, “path is a dir”);

my $temp = “${path}_”.time.’.temp’;
while (-f $temp && –$try){
sleep (1);
$temp = “${path}_”.time.’.temp’;
}

$try or return (0, “can’t get unique file name: $temp”);

(open (FILE, “>$temp”)) or return (0, “OPEN ERROR: $temp, $!”);
binmode FILE;
print FILE $contents;

(close (FILE)) or return (0, “CLOSE ERROR: $temp, $!”);

while($generation–){
if ($generation == 0){ #最新ファイルを書き換え
rename($temp, $path)
or return (0, “file replacement failed ($temp, $path) : $!”);
} elsif ($generation == 1) { #最新だったファイルを世代1へ
if (-f $path){
rename($path, “$path.1”)
or return (0, “file replacement failed ($path, $path.1) : $!”);
}
} else {
my $before = sprintf(“$path.%d”, $generation-1);
my $after = sprintf(“$path.%d”, $generation);
if (-f $before){
rename($before, $after)
or return (0, “file replacement failed ($before, $after) : $!”);
}
}
}
return (1, $path);
}