Perl 的 CGI/多进程情况下，如果多个进程（或 CGI 实例）同时写入同一个文件，直接 save 会导致数据丢失或损坏（比如 A、B 进程各自读、写，后写的覆盖前写的所有更改）。

最常用可靠方案是文件锁（flock）+ 读-合并-写，确保每次 save 的是最新的、所有其它进程已持久化的数据的叠加。

推荐实现方案

1. 在 save 前获取排他锁（flock）

2. save 前先 reload 并 merge 数据

3. 多进程安全 save 代码示例

use Fcntl qw(:flock);

sub save {
    my ($self, $filename) = @_;
    die "No filename provided" unless $filename;

    # 打开文件并加写锁
    open my $fh, "+<", $filename or open $fh, ">", $filename or die "Can't open $filename: $!";

    flock($fh, LOCK_EX) or die "Cannot lock $filename: $!";

    # 读取磁盘上的最新数据（如果有）
    my $disk_data;
    eval {
        seek($fh, 0, 0); # 回到文件头
        local $/; # slurp mode
        $disk_data = -s $filename ? Storable::fd_retrieve($fh) : {};
    };
    $disk_data ||= {};

    # 合并内存和磁盘数据
    foreach my $key (keys %{ $self->{store} }) {
        if (!exists $disk_data->{$key}) {
            $disk_data->{$key} = $self->{store}->{$key};
        } else {
            # 合并所有版本
            my $disk_versions   = $disk_data->{$key}->{versions}   || {};
            my $memory_versions = $self->{store}->{$key}->{versions} || {};
            foreach my $ver (keys %$memory_versions) {
                $disk_versions->{$ver} = $memory_versions->{$ver};
            }
            $disk_data->{$key}->{versions} = $disk_versions;

            # 更新 latest_version
            $disk_data->{$key}->{latest_version} = $self->{store}->{$key}->{latest_version}
                if $self->{store}->{$key}->{latest_version} > $disk_data->{$key}->{latest_version};
        }
    }

    # 截断并写回
    seek($fh, 0, 0);
    truncate($fh, 0) or die "Truncate failed: $!";
    Storable::store_fd($disk_data, $fh) or die "Unable to save database to $filename: $!";

    close $fh;

    # 更新内存最新数据
    $self->{store} = $disk_data;

    return 1;
}

模块精简版 + 多进程安全 save

请将以下完整代码替换你的 KVDatabase.pm：

package KVDatabase;

use strict;
use warnings;
use Storable qw(store retrieve store_fd fd_retrieve);
use Fcntl qw(:flock);

sub new {
    my $class = shift;
    my $self = {
        store => {},
    };
    bless $self, $class;
    return $self;
}

sub exist {
    my ($self, $key) = @_;
    return exists $self->{store}->{$key};
}

sub set {
    my ($self, $key, $value) = @_;
    if (exists $self->{store}->{$key}) {
        my $ver = ++$self->{store}->{$key}->{latest_version};
        $self->{store}->{$key}->{versions}->{$ver} = $value;
    } else {
        $self->{store}->{$key} = {
            versions       => { 1 => $value },
            latest_version => 1,
        };
    }
    return 1;
}

sub get {
    my ($self, $key, $version) = @_;
    return undef unless exists $self->{store}->{$key};
    my $versions = $self->{store}->{$key}->{versions};
    if (defined $version) {
        return exists $versions->{$version} ? $versions->{$version} : undef;
    } else {
        my $latest = $self->{store}->{$key}->{latest_version};
        return exists $versions->{$latest} ? $versions->{$latest} : undef;
    }
}

sub delete {
    my ($self, $key) = @_;
    return 0 unless exists $self->{store}->{$key};
    delete $self->{store}->{$key};
    return 1;
}

sub version {
    my ($self, $key) = @_;
    return undef unless exists $self->{store}->{$key};
    return $self->{store}->{$key}->{latest_version};
}

# 多进程安全持久化
sub save {
    my ($self, $filename) = @_;
    die "No filename provided" unless $filename;

    open my $fh, "+<", $filename or open $fh, ">", $filename or die "Can't open $filename: $!";

    flock($fh, LOCK_EX) or die "Cannot lock $filename: $!";

    # 读取磁盘上的最新数据（如果有）
    my $disk_data;
    eval {
        seek($fh, 0, 0);
        local $/;
        $disk_data = -s $filename ? fd_retrieve($fh) : {};
    };
    $disk_data ||= {};

    # 合并内存和磁盘数据
    foreach my $key (keys %{ $self->{store} }) {
        if (!exists $disk_data->{$key}) {
            $disk_data->{$key} = $self->{store}->{$key};
        } else {
            my $disk_versions   = $disk_data->{$key}->{versions}   || {};
            my $memory_versions = $self->{store}->{$key}->{versions} || {};
            foreach my $ver (keys %$memory_versions) {
                $disk_versions->{$ver} = $memory_versions->{$ver};
            }
            $disk_data->{$key}->{versions} = $disk_versions;

            if ($self->{store}->{$key}->{latest_version} > $disk_data->{$key}->{latest_version}) {
                $disk_data->{$key}->{latest_version} = $self->{store}->{$key}->{latest_version};
            }
        }
    }

    seek($fh, 0, 0);
    truncate($fh, 0) or die "Truncate failed: $!";
    store_fd($disk_data, $fh) or die "Unable to save database to $filename: $!";

    close $fh;

    $self->{store} = $disk_data;

    return 1;
}

sub load {
    my ($class, $filename) = @_;
    die "No filename provided" unless $filename;
    my $restored = retrieve($filename) or die "Unable to load database from $filename: $!";
    my $self = {
        store => $restored,
    };
    bless $self, $class;
    return $self;
}

1;

说明