Open MagicVox.net
実験的に Comet サーバ の Perl 実装を書いてみたのだけれど、負荷テストをするためには同時に多数のクライアントから接続要求を行う必要があります。そこで今回、Perl の threads モジュールを使って、多重リクエストを行うスクリプトを書いてみました。VMware Player を利用した仮想マシン上で、50 スレッドくらいまで多重化することができました。
後から考えると、どうしてこんな複雑なことしているんだろう？ って思ったんですが… メインループ内で Thread::Queue を使ってワーカースレッドの数を監視し、ワーカースレッドの処理が終わってスレッドが破棄されると、次々にワーカースレッドを生成します。特に問題なさそうに見えて、スレッドの生成と破棄を繰り返す間にどんどんヒープメモリを食い潰すようです。3000 クライアントID ぐらいあたりからスワップを始めます(´･ω･`)ｼｮﾎﾞｰﾝ
#!/usr/bin/perl
$|++;
use strict;
use threads; # http://perldoc.jp/docs/modules/threads-1.67/threads.pod
use Thread::Queue;
use LWP::UserAgent;
use HTTP::Request;
use Time::HiRes;
use constant {
THREADS_NUM => 30, # スレッドの生成数
};
### ワーカースレッド監視用のキュー
my $queue = Thread::Queue->new;
### ワーカースレッドを生成するメインループ
my $client_id = 0;
while (1) {
while ($queue->pending < THREADS_NUM) {
printf STDERR "* Create Client(ID:%d)
", $client_id;
$queue->enqueue ($client_id++);
threads->new (&do_request, $client_id, 30 < rand 100)->detach;
}
}
### ワーカースレッド
sub do_request {
my ($client_id, $action) = @_;
my $ua = LWP::UserAgent->new
or die 'Failed to initialize LWP::UserAgent';
if ($action) {
printf "tClient(ID:%d) is a listener
", $client_id;
$ua->request (HTTP::Request->new (GET => 'http://vm:9000/'));
}
else {
printf "tClient(ID:%d) is a speaker
", $client_id;
sleep rand 30;
$ua->request (HTTP::Request->new (POST => 'http://vm:9000/'));
printf "tClient (ID:%d) speaks
", $client_id;
}
$queue->dequeue;
}
普通に考えた(;´Д｀) 最初に必要な数だけワーカースレッドを生成しておいて、ワーカースレッド内で無限ループしてしまえばいいんじゃない？ という版。Thread::Queue とか不要で、今のところ長時間走らせても大丈夫そうに見えている…
#!/usr/bin/perl
$|++;
use strict;
use threads; # http://perldoc.jp/docs/modules/threads-1.67/threads.pod
use LWP::UserAgent;
use HTTP::Request;
use Time::HiRes;
use constant {
THREADS_NUM => 50, # スレッドの生成数
};
### ワーカースレッドの生成
my @threads;
push @threads, threads->new (&do_request, $_) for (1..THREADS_NUM);
$_->join for @threads;
### ワーカースレッド
sub do_request {
my ($client_id) = @_;
my $ua = LWP::UserAgent->new
or die 'Failed to initialize LWP::UserAgent';
while (1) {
if (30 < rand 100) {
printf "Client(ID:%d) is a listener
", $client_id;
$ua->request (HTTP::Request->new (GET => 'http://vm:9000/'));
}
else {
sleep rand 30;
$ua->request (HTTP::Request->new (POST => 'http://vm:9000/'));
printf "Client(ID:%d) speaks
", $client_id;
}
threads->yield;
}
}
English