Perl CGI でWEBサーバから高速に最新値を取得する

node.js あたりを使って非同期に動作させていればこんな苦労はないのでしょうがｗ

運用してるWEBサーバで、クライアント側の更新が必要かどうかだけを問い合わせたい時があります。

めったに変更されない値が変更されたかどうか、とか、

表示している内容が最新なのかどうか、とか。

jquery.timers.js を使って、everyTime, stopTime メソッドを呼び出せば定期的にサーバーに問い合せすることができます。

今回必要だったのが、データベース上のシーケンシャルなIDの更新状態です

ブラウザ上には一覧が表示されてるのですが、サーバー上では不定期にIDが追加されますので、現在表示している内容が最新かどうかを問い合わせたいわけです。

select count(*) from table where id>last_id; 

SQLを発行すれば、最新の件数がすぐに取得できます。

でもね、id ってときどきしか増えないのに、できるだけ早く検知するには everyTimeのインターバルを短くしなきゃならないわけで、無駄だなーと思うわけです。

しかも CGI 側では DBI::connect, disconnect, 戻り値のjsonだのXMLの出力を実施するんで、大量に利用者がいるとサーバーの負荷たるや、半端ない状態に陥ることまちがいなしです。

最新の値だけをファイルに書き込んでおいてそれを読みだすという方法も考えました。

それも open～close のオーバーヘッド考えるとわざわざ最新IDをファイルに保存するのは余計な処理と思ってしまいます。



そこで！

ファイルのタイムスタンプを利用してＩＤ管理できるんじゃなかろうか、という発想のもと作成したクラスが、これ。

package FastSerialHolder;
#============================================
# 2018/01/26 
#============================================
# 最新のIDを管理するクラス
# ファイルのタイムスタンプを使ってデータを保持させる
# ファイルの内容はアプリケーションごとに任意に書き込み
# atime<<32+mtime で63bitの値を管理する。
# ただし、atime はマウントにより使用していない場合もあるので注意
#============================================
our $FshBasePath = '任意のフォルダ';

#
#   コンストラクタ
#
sub new
{
    my ($self, $name, $group, $def_value) = @_;
    my $path = $FastSerialHolder::FshBasePath;
    #再帰的なディレクトリ作成はCGIでエラーになるので個別に作る
    #グループを階層化したい場合には、あらかじめディレクトリを作っておく
    if(! -d $path)
    {
        mkdir($path);
    }
    if(defined($group))
    {
        $path .= '/';
        $path .= $group;
        if(! -d $path)
        {
            mkdir($path);
        }
    }
    $def_value = 0 if(!defined($def_value));
    $def_value = 0 if($def_value !~ /^\d+$/);
    my $filename = $path . '/' . $name . '.fsh';
    my $object = bless {
  path => $path,
  name => $name,
  filename => $filename,
  current => $def_value,
  defualt => $def_value,
  handle => undef
 }, $self;
    if(! -e $filename)
    {
 $object->SetSerial($def_value);
    }
    return $object;
}

#
# 最新IDを取得する
#
sub GetSerial
{
    my ($self) = @_;
    if(! -e $self->{filename})
    {
        $self->{current} = $self->{default};
        return $self->{current};
    }
    my @st = stat($self->{filename}); # atime=$st[8], mtime=$st[9]
    my $hi = $st[8] << 32;
    my $lo = $st[9] & 0xFFFFFFFF;
    my $serial = ($hi + $lo) >> 1;
    return $serial;
}

sub SetSerial
{
    my ($self, $serial) = @_;
    if($serial < 0)
    {
        $serial = $self->{defualt};
    }
    if(! -e $self->{filename})
    {
        #ファイル作成
        if(open(my $fh, ">", $self->{filename}))
        {
            close($fh);
        }
    }
    my $rc = false;
    my $val = ($serial << 1);
    my $lo = ($val & 0xFFFFFFFF);
    my $hi = ($val >> 32);
    $rc = (0 < utime($hi, $lo, $self->{filename}));
    if($rc)
    {
        $self->{current} = $serial;
    }
    return $rc;
}
 

コメントなくてすみませんｗ

ようするに、ファイルシステムの更新時間とアクセス時間を変更して数値として取り扱うわけです。

実際には派生クラスを使って特定のグループごとにフォルダを分けて使うようにしてますが

使い方としては、最新値を取り出す場合は

my $idManager = new FastSerialHolder(名前,グループ名,初期値);
my $current = $idManager->GetSerial();

データベースが更新されたタイミングで

my $idManager = new FastSerialHolder(名前,グループ名,初期値);
$idManager->SetSerial(最新値);

とするだけです。



CGIでは、まず最新値があるかどうかの比較だけを行っておき、「あるよ」って返事が来たらデータベースにアクセスさせる別のCGIを呼び出すようにすればいいわけです。

実装して動かしてみると、とってもサクサクで快適です！

【備考というか補足というか】
実際に動かしたのは、CentOS 6.4 64bit です。

値を１ビットシフトしてるのは、ファイルシステムが秒の記録を２秒単位にしてた（昔の）記憶に頼ったもので、正しいかどうかは不明ですｗ

mkdir じゃなくて mkpath 使えと言われそうですが、初回生成時に STDOUTにprintするので、使わないようにしてます

stat で返される、atime と mtime が実際にファイルシステム上で何ビットなのか調べたけどわからなかったので（笑）、32bit だと思い込んで書いてます。

ファイルアクセスを高速化するために atime を無効にマウントされてる場合は 31bit しか扱えません。注意してください。（未検証）

0バイトでもクラスタ使っちゃうのかも・・・（そうなのかな？


画期的な方法だと思い込んでますが、きっと既出か、あるいはよくない実装って怒られるのか、どちらなのかもしれません。