Perl で加重ラウンドロビン

あけましておめでとうございます。

さて、ラウンドロビンというのは、主に負荷分散のため使われる手法で、複数のリソースに対して順番に処理を割り当てるためのアルゴリズムです。さらに、各リソースの処理性能であるとか、状況に応じて割り当てる確率を変えるために、それぞれに重み付けを行うケースがあります。その際に使われるのが、加重ラウンドロビンというアルゴリズムです。

新年早々アプリケーション層でそういうことをやりたい機会があったので、Perl でラウンドロビンを実装しました。いまいち洗練されてないんですが、メモがてら。

まずは、ラウンドロビン。配列で与えられたリソースのから、利用可能なものを順に引いてきます。

#!/usr/bin/perl
my @DATA = ( { name => 'A', available => 1 }, { name => 'B', available => 1 }, { name => 'C', available => 1 }, { name => 'D', available => 0 }, { name => 'E', available => 1 }, );
our $i = -1; # last time index for (1..10) { my $data = select_data(); if (defined $data) { print sprintf("%d\t%s\n", $_, $data->{name}); } else { print sprintf("%d\tAll datas are unavailable\n", $_); } }
sub select_data {
my $j = $i; do { $j = ($j + 1) % scalar(@DATA); if (${DATA[$j]}->{available}) { $i = $j; return ${DATA[$j]}; } } while ($j != $i); return undef; }

実行結果。

1       A
2       B
3       C
4       E
5       A
6       B
7       C
8       E
9       A
10      B

続いて、加重ラウンドロビン。最大公約数や重みの最大値を毎回計算しているのは、利用可能なリソースが動的に変化することを想定していたためです。実際には、最初に計算して memcached に載せたあとは、リソース状況に変化があった際にメモリを上書きするようにしました。

#!/usr/bin/perl
use Math::BigInt qw(bgcd); use List::Util qw(max);
my @DATA = ( { name => 'A', available => 1, weight => 2 }, { name => 'B', available => 1, weight => 3 }, { name => 'C', available => 1, weight => 4 }, { name => 'D', available => 0, weight => 1 }, { name => 'E', available => 1, weight => 1 }, );
our $i = -1; # last time index our $cw = 0; # current weight
for (1..10) { my $data = select_data(); if (defined $data) { print sprintf("%d\t%s\n", $_, $data->{name}); } else { print sprintf("%d\tAll datas are unavailable\n", $_); } }
sub select_data { my @list = grep { $_->{available} } @DATA; my $gcd = bgcd(map { $_->{weight} } @list); my $max = max(map { $_->{weight} } @list);
while (1) { $i = ($i + 1) % scalar(@list); if ($i == 0) { $cw = $cw - $gcd; if ($cw <= 0) { $cw = $max; return undef if ($cw == 0); } } if ($list[$i]->{weight} >= $cw) { return $list[$i]; } } }

実行結果。

1       C
2       B
3       C
4       A
5       B
6       C
7       A
8       B
9       C
10      E

ラウンドロビンは、単純に順番に割当をおこなうアルゴリズムなので、結果には規則性があります。なので、『くじ』のような当たるプログラムには向きません。

複数のなかからひとつを選ぶ場合、バカのひとつ覚えのように、なにかとランダム関数を使ってしまうのですが、目的に応じて戦略は変えるべき、というのを改めて感じたのでした。(ランダムが実はランダムじゃないという話も含めて)

FileCache と Memcached を比較する

設計方針として「Memcached より先に FileCache を見るように」という話を聞いたので、「えー、それって性能的にどうなんだろうか?」と思い、簡単にベンチマークをとってみました。

環境としては、同一セグメント内のまったく別のホストに Memcached サーバを立てました。つまり、I/Oコストだけでなく通信コストなども含めての比較をしています。

ちなみに、このベンチのために、わざわざ memcached を入れるところから始めました。もちろん連休で時間があるからです。

ソース。

#!/usr/bin/perl -w
use strict;
use warnings;
use utf8;

use Cache::FileCache; use Cache::Memcached::Fast; use Benchmark qw(:all);
our $c = 0;
my $count = 10000; my $compare = timethese( $count, { filecache => sub { $c = 0; my $cache = Cache::FileCache->new({ namespace => 'test', default_expires_in => 600, cache_root => '/tmp', }); my $data = $cache->get('key' . $c++); unless ( defined $data ) { $cache->set('key' . $c++, 'value'); } return $data; },
memcached => sub { $c = 0; my $cache = Cache::Memcached::Fast->new({ servers => ['192.168.50.102:11211'], }); my $data = $cache->get('key' . $c++); unless ( defined $data ) { $cache->set('key' . $c++, 'value'); } return $data; }, }, );
cmpthese $compare;

10000 回の R/W の結果はこちら。

Benchmark: timing 10000 iterations of filecache, memcached...
 filecache:  5 wallclock secs 
 ( 4.55 usr +  0.76 sys =  5.31 CPU) @ 1883.24/s (n=10000)
 memcached:  7 wallclock secs 
 ( 0.26 usr +  0.15 sys =  0.41 CPU) @ 24390.24/s (n=10000)
             Rate filecache memcached
filecache  1883/s        --      -92%
memcached 24390/s     1195%        --

なんと FileCache の圧倒的な勝利。ネットワークコストが大きかったのか、想定外の差が出て驚きました。冒頭の設計方針に一理あるということは分かりました。疑ってすみません。しかし何か根本的なところを間違っていそうな気もしなくはないなあ。

最近は、ディスクI/Oをとにかく敵対視する日々が続いていたけれども、先入観というか偏りのある発想になってしまってはいけないですね。反省。

ちなみに、「じゃあ Memcached やめて FileCache を積極的に使っていこうぜ!」とはもちろんならないです。それぞれの環境に応じて求められるものは変わってくるし、分散であったり failover しやすかったりという優位性があるので、それなりの規模で総合的に判断すると、 Memcached に軍配が上がるんではないでしょうか。逆に言えば、スタンドアローンだったり、Webサーバ1台・DBサーバ1台みたいな環境であれば、FileCache の方がメリットが大きそうですね。

ベンチの見方を盛大に誤っていまして、上記でまったく逆の考察をしていますが、誤爆です。やはり超圧倒的に Memcached が高速でした。wallclock secs を見ていたのですが、普通に秒間処理で測るんですよね。10倍以上の性能差です。

なので、考察としては、よほどネットワークコストが大きいとか、ディスクI/Oに対してメモリが不足しているとか、共用環境で memcached 立てられないといった限定的な環境以外では、FileCache の出番は無いということです。今回の検証は HDD でしたが、SSD にしても改善される性能は 2-3 倍程度でしょうから、Memcached の優位性は変わらないでしょう。

LWP でベーシック認証に対応する

自分メモ。

LWP で ベーシック認証のかかったページにアクセスするには、authorization_basic を使えば良いらしい。簡単だ。

#!/usr/bin/perl
use strict;
use LWP::UserAgent;
use HTTP::Request;

my $req = HTTP::Request->new(GET => "https://foo.bar.com/basic/auth.html"); $req->authorization_basic('account', 'password'); my $ua = LWP::UserAgent->new(); my $res = $ua->request($req);
if ($res->is_success) { print $res->content; } else { print $res->code; }

perl で配列に要素が含まれているか調べる方法

ある配列に特定の要素が含まれているかどうか知りたいとき、 java では List#contains が用意されていますが、どうやら perl では標準で用意されていないんですね。ここら辺を自前で書くのが perl 流といったところでしょうか。

#!/usr/bin/perl -l

my @array = qw/a b c d e f g/; undef %tmp; for (@array) { $tmp{$_} = 1; }
print $tmp{"a"} ? 'true' : 'false'; print $tmp{"h"} ? 'true' : 'false';

数値配列で有無をチェックする場合は、vec を使う方法で軽くできるとのこと。

perl で mkdir -p

perl で mkdir -p 同様のことをするには、File::Path の mkpath を使うと良いらしい。

#!/usr/bin/perl -w

use strict; use warnings; use File::Path;
my @dir = mkpath ('/data/test/1/2/3/'); for (@dir) { print $_ . "\n"; }

実行結果は、作成したディレクトリパスの配列。以下は、/data/test が存在していた場合の結果。

/data/test/1
/data/test/1/2
/data/test/1/2/3

ラクチンです。危なく自分でループ回すところでした。

なかなか便利なモジュールのノウハウが蓄積されないので、やりたいことがあったら、まずはモジュールを探してみる癖を付けるようにしたいなあ。perl ってサクサク書けるので、ちょっとした処理だったら自前でサブルーチン用意してしまっているんですが、本当はもったいないですよね...。

学習ベースの防備録として今後モジュール関連ネタ、メモしていきます。

perl でビット演算の結果を数値比較する際の注意点

ハマったのでメモ。

perl で、ビット演算の計算結果と数値を比較する判定文を書いたら、これがうまくいかない。書いたのは、次のようなコード。

if ($var & 1 == 0) {
	print $var;
}

$var の値が 1 だろうが 0 だろうが、とにかく結果は 0 となって $var が出力されない。これだけシンプルだと逆に原因が特定できずに困る。

答えは、「Perl の演算子と優先順位」にありました。要するに、比較演算子の方が、ビット演算子より先に評価されたため、常に演算結果が 0 となっていたのでした。これは盲点。

ということで、以下のように修正して解決。

if (($var & 1) == 0) {
	print $var;
}

このことは、特段 perl に限った話ではなくて、php でも同様だったし、java にいたってはコンパイルエラーになってしまった。(eclipse では、エラーに対して、親切に「小括弧内にビット演算命令を入れます」というヒントまで出てきた)

ビット演算は便利なのでよく使ってしまうんですが、評価順を意識しておかないと、思わぬバグが出てしまうことになるので、要注意ですね。

Thunderbirdでメールの件名が文字化けする

perlで書いたメールフォームから送信したメールの件名(日本語)が、Thunderbirdでだけ文字化けする。

結論から言うと、件名のエンコード処理が抜けていたので文字化けしていた。Outlookなどは、空気を読んで勝手に文字コード判別をしてくれていたので、適切な表示がなされていたようだ。えー、要するに Thunderbird は KY ってことで。

悪態ついてないで、ソース修正。

# 修正前
my $subject = MIME::Base64::encode($mailsubject, "");
chomp $subject;
$subject = "=?ISO-2022-JP?B?$subject?=";

Base64でエンコードする前に、入力文字列($mailsubject)を、ISO-2022-JP(JIS)に変換してあげる必要がある。

# 修正後
$mailsubject = Jcode::convert($mailsubject, 'jis');
my $subject = MIME::Base64::encode($mailsubject, "");
chomp $subject;
$subject = "=?ISO-2022-JP?B?$subject?=";

これでメールクライアントによらず文字化けせずメール送信できるようになった。これって、すごい基本的な処理フローだと思うのだけど、今まで知らずに生きてきた。恥ずかしい。すみません。生れて、すみません。二十一世紀旗手ですよ。

メールの長い件名が文字化けするときは

perlで書いたメールフォームで、件名をめっちゃ長くしてみたら文字化けした。

my $subject = MIME::Base64::encode($mailsubject);
chomp $subject;
$subject = "=?ISO-2022-JP?B?$subject?=";

なんじゃろうと思って調べてみると、原因はMIME::Base64のエンコード処理だった。たぶん基本的なことだと思うのだけど、今まで支障がなくて気付かなかった。ううう。

encode_base64関数は、以下のような動きをするのが仕様。

返されるエンコードされた文字列は76文字を越えないように分割され、空文字列でなければ$eolが最後に付きます。もしエンコードされた文字列を複数の行に分割したくない場合は、2番目の引数として空白の文字列を渡してください。

要は、長い件名にしちゃうと勝手に改行コード入れちゃうから文字化けするって話。改行されたくなかったら、第2引数に空文字を指定しましょう、と。引数2つ取れることなんて、知らなんだ。無知は怖い。まんじゅう怖い。お茶も怖い。

ということで、以下のようにしてアッサリ解決。

my $subject = MIME::Base64::encode($mailsubject, "");

ちゃんとドキュメント読まないとダメってことですな。

Unrecognized character \xE3

Perlさん曰く、「Unrecognized character \xE3」である。

一瞥すると何のことか分からないのだけど、要するにクォーテーションの関係性が崩壊していて、プログラムが理解できないということ。最も単純な話では、クォーテーションの閉じ忘れがある。

今回はテンプレートエンジンを噛ませていて、テンプレートタグを展開したリテラルに、クォーテーションが含まれていたため、関係性が崩壊していた。「'」を「'」に置換してから取扱うように変更すれば良いんだけど、表示側のソースをいじりたくなくて、DBへのINSERT処理側を改造。ホントはダメなんだけど、HTML表示にしか使わないデータだから良しとする。

怠慢って素晴らしいという話。

sendmail が勝手に改行コードを挿入する件

sendmail 君ってば、未改行の長文をメールしようとすると、勝手に改行コードを挿入してくれちゃうのね。知らなかった。うちの環境だと、986バイトを超えると強制改行コード。優しい仕様だとは思うんだけど、2バイト文字を分断してでも改行コード入れる一途さに、ちょっと辟易。

どうしようもないので、sendmail に文字列を渡す前に、自前で長すぎるテキストを改行するように変更。もちろんマルチバイト対応で。

続きを読む "sendmail が勝手に改行コードを挿入する件"

モジュールを追加する

CPAN から何かをインストールしようとするたびに、いつも方法を忘れているので、メモ。

# perl -MCPAN -e shell
cpan> install モジュール名
   [インストール]
cpan> quit

FTP がうまくいかずにインストールが止まってしまったりすることも。そういうときは、ソースからインストールすべし。個人的には、ソースからの方が意味が分かってスッキリする。所詮は古い人間だもの。

# perl Makefile.PL
# make
# make test
# make install

しかし、そもそも今どんなモジュールを組込んでいるのか忘れていて、本当に追加すべきかどうかが分からない。あれ、このモジュールって入っているんだっけか。二歩進んで三歩下がるこのブログ。

「使用可能なモジュールの一覧取得」
「Perlモジュールの確認」

この辺を見て解決。@INC を使えば良いのか、なるほど。ちなみに、今から入れようと思っていたモジュールは全て組込み済みでしたよ。ムダ足ご苦労さん。ううう。

SWF::Builder の効用








SWF::Builder を使えば、CGI を通して動的に Flash を生成することができるわけですよ。こりゃあ面白いと思って、しばし使いどころを考えていたんだけど、別に Flash 内部に吸収すればできるんじゃないのって話ばかり。間に perl を挟む利点が、思いつかないなあ。

他の人はどんな使い方してんだろうと思って検索したら、フォント周辺で上手いことやろうってことで盛り上がってるっぽい。とりあえず、generative.info さんとこの「SWF::BuilderでLinuxサーバー上でフォント生成は可能か」という熱いエントリーを追いつつ、自分でもベンジャミンの名言で挑戦。うん、できた。素敵!

でもでも、単にサーバサイドで入力文字列をフォント化するのであれば、SWF::Builder じゃなくてもイケるよなあ、と。もっと、サーバが動的に swf ファイルを生成することの意味があるような使い方って、無いんだろうか。

パラメータに合わせて動きが変わるような Flash ならば、それは Flash 内部でそういう風に作りこめば良い。SWF::Builder の効用を考えるなら、入力内容を swf 生成時に埋め込まないといけないようなもの…。うーん。

Flash が Flash を作って読み込んで、その Flash がまた Flash を作って…みたいなこととかしたら、意味ないけど面白かったりするのかなあ。あー、データ収納箱として swf ファイルを使ったりするか。サウンドも使えるっぽいし、そこに全部詰め込むとかね。苦しいか。

とりあえず、ちょっと寝かせておこうっと。

SWF::Builder を使ってみる








前回インストールした SWF::Builder を使って実際に flash を作成してみた。率直な感想として、かなり面白い。今回は静的にコードを書いて描画したんだけど、CGI を絡めて動的に描画することも可能なわけで。アイデア次第でいかようにも拡がりそう。素敵だ。

ちなみに、このチンケなムービー、ずっと見てると酔いそうになる。申し訳ない。

とりあえず、例によってソースさらしておきまふ。

続きを読む "SWF::Builder を使ってみる"

SWF::Builder のインストール

CPAN をうろついていたら、SWF::Builder という面白げなモジュールを発見。perl で flash が作れるなんて、かなり素敵なことが起こりそうじゃないですか。

というわけで、以下インストールのメモ。

続きを読む "SWF::Builder のインストール"

HTML::Template を使用した二段組

MVC モデルに慣れ親しんだせいで、画面とロジックを共存させる旧来の perl のやり方が、スゲーうさん臭く思えていた。それだけに HTML::Template モジュールとの出会いは衝撃的。もう、これ無しで perl を使ったWebアプリなんざ作れないっすよ、お兄さん!

そんな愛しの HTML::Template モジュールのなかでも、とりわけ重宝しているのが、loop_context_vars オプション。jsp とか velocity だと、計算のロジック入れないといけない二段組が、スゲー簡単に実現できたりする。かゆいところに手が届いていて良い感じ。素敵です。

以下、サンプルソース。

続きを読む "HTML::Template を使用した二段組"