懐かしの CGI カウンターとか

#!/usr/bin/perl
# カウンターのサンプル

use strict;
use warnings;

use Time::HiRes qw(sleep);

my $count_file = './count.dat';

main();

sub lock_file {
    my $fname = shift;
    my $lock_dir = "$fname.lock";

    # ロックが 10 秒以上前なら強制解除
    if (-e $lock_dir && (stat _)[9] + 10 < time()) {
        # 削除失敗でロックディレクトリが残ってたら失敗
        (! rmdir $lock_dir or ! -e $lock_dir) or die "Cannot remove dir $lock_dir: $!";
    }

    # 3 回リトライする
    my $cnt = 0;
    while ($cnt++ < 3) {
        mkdir $lock_dir, 700 and return 1;
        sleep(0.1);
    }

    return;
}

sub unlock_file {
    my $fname = shift;
    my $lock_dir = "$fname.lock";

    if (! rmdir $lock_dir && -e $lock_dir) {
        die "Cannot remove dir $lock_dir: $!";
    }
    return;
}

sub main {
    # ファイルのロックを試みる
    lock_file($count_file) or die "Cannot lock file $count_file";

    my $fh;
    my $val;
    if (open $fh, '+<', $count_file) {
        $val = do { local $/; <$fh> };
        ++$val;
        seek $fh, 0, 0;
    }
    else {
        # ファイルがなければ新規作成
        open $fh, '>', $count_file
            or die "Cannot open file $count_file: $!";
        $val = 1;
    }

    print {$fh} $val;
    close $fh;

    # JSON 形式で返す
    print qq/"{"result":"OK","count":$val}"/;

    unlock_file($count_file);
}