ぐま あーかいぶ

とても久しぶりに Perl で 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);
}