チェックデジットとは

さて、「CheckDegit(チェックデジット)」という言葉に馴染みのない方もいらっしゃると思うので、まずは基本的なお話から。

Wikipediaによると、

「チェックディジット（check digit, 検査数字）とは、
符号の入力誤りなどを検出するために元の符号に付加される数字のこと。」

とされています。

馴染みの深いところでは、バーコードなどで読み取りミスを防ぐために、最後の一桁にチェックデジットを付与して、データを誤って読み取ってしまうことを防いでいます。

例えば、「初めてのPerl」のISBN"978-4-87311-126-1"の最後の"1"はチェックデジットです。

計算してみる

まずは実際に上のISBNコードのチェックデジットを計算してみます。

ISBNコードやJANコードは、「モジュラス10 ウェイト3・1」というアルゴリズムで算出されます。

このアルゴリズムでは、"左から奇数桁の数字の合計"と、"偶数桁の数字の合計を3倍にしたもの"を加え、10からその和の下一桁の数字を引いてチェックデジットを求めます。

(9 + 8 + 8 + 3 + 1 + 2) + (7 + 4 + 7 + 1 + 1 + 6) * 3 = 109 ・・・下一桁は9
10 - 9 = 1 ・・・ この1がチェックデジット

確かに計算結果と実際の値とが一致しました。比較的簡単な計算のアルゴリズムですね。

Perl登場｜・ω・)ノ

Perlの苦手な方はチェックデジットくらい暗算をするみたいですが、

小学校を卒業した賢いCasual Perlerの皆さんは当然Perlを使いますよね。

というわけで、Perlで簡単にチェックデジットを付与し、あるいは検証するモジュールの紹介です。

Algorithm::CheckDegits

use Algorithm::CheckDigits;

my $isbn13 = CheckDigits('ISBN13');
if ($isbn13->is_valid('978-4-87311-126-1')) {
    # OK
}

my $lp_isbn = $isbn13->complete('978-4-87311-126');
print $lp_isbn . "\n";

上の通り、CheckDigits()関数にて付与したいチェックデジットの種類を指定します。

ここでは、13桁の新ISBNコードを使っていますので、"ISBN13"という指定をしています。

他には、クレジットカードの"VISA"や"AMEX"、"DINERS"、Amazon等でおなじみの"EAN"(JANもこれと同じ)などが指定できます。

指定できるアルゴリズム名の一覧は、

my @ml = Algorithm::CheckDigits->method_list();

で取得できます。

ちなみに、m10_005などという命名がなされていますが、それは必ずしも名前通りモジュラス10ウェイト5という意味ではないようですので注意が必要です。

※実際にはm10_004がモジュラス10ウェイト3.1に該当、m10-005がモジュラス10ウェイト4.9に該当など

実際のアルゴリズムを確認したい場合は、以下のようにperldocを参照するか、ソースをご覧ください。

perldoc Algorithm::CheckDigits::M10_005

様々な用途

チェックデジットというのは、数値の検証に用いるのが本来の用途だと思いますが、それ以外にも私自身は以下のような用途で使っています。

• IDの桁数を揃えたい場合で、桁数に余裕があり、かつ連番やゼロを避けたいとき(00001,00002,00003...よりも00016,00025,00034...とすることで連番を避けた様に見える)
• JANコードやISBN等を保存する際、1文字分の容量を節約したいとき
• 彼女の誕生日の下一桁を忘れたとき

クリスマスチェックデジット

チェックデジットでクリスマスがcompleteできるか遊んでみました。

my $christmas = CheckDigits('EAN');
print $christmas->complete('2009122'); # 結果はご自身でご確認ください:)

最後に

さて、25日間にわたってお楽しみいただいたJperl Advent Calendar - Casual Trackも今日で最後となりました。

毎日欠かさずチェックいただいたcasual perlerやperl hackerの皆さんありがとうございました。

そして、今日まで途切れることなくバトンをつないで頂いたcasual perlerの皆様お疲れ様でした。

また来年のAdvent Calendarに参加できることを楽しみにしています。

それでは、皆様良いお年を。

参考

• http://search.cpan.org/~mamawe/Algorithm-CheckDigits-0.53/
• http://ja.wikipedia.org/wiki/%E3%83%81%E3%82%A7%E3%83%83%E3%82%AF%E3%83%87%E3%82%A3%E3%82%B8%E3%83%83%E3%83%88
• http://ja.wikipedia.org/wiki/JAN%E3%82%B3%E3%83%BC%E3%83%89

Special Thanks

id:kimury

はじめに

まずはImage::Imlib2をインストールしましょう。

インストールをする前に、Cのライブラリと使いたい画像形式のライブラリを入れておきましょう。

今回はjpegとpngを使いたいと思います。

$ port install libpng
$ port install imlib2

ではImage::Imlib2をインストールします。簡単ですね！

cpan> install Image::Imlib2

画像の読み込み、書き出し

インストールできたら、画像を読み込んだり書き出したりしてみましょう。

face.jpgを読み込んで、face2.jpgに書き出してみます。

#!/usr/bin/perl

use strict;
use warnings;
use Image::Imlib2;

my $dir = '/path/to/image';

my $image = Image::Imlib2->load("$dir/face.jpg");
$image->save("$dir/face2.jpg");

できた画像

画像の合成

これであなたもImage::Imlib2を使うことができました！が、肝心のアイコンがさみしいです＞＜

クリスマスということで、サンタ帽をかぶってみましょう。

このようなサンタ帽画像を用意します。それでは合成してみましょう。

#!/usr/bin/perl

use strict;
use warnings;
use Image::Imlib2;

my $dir = '/path/to/image';

my $image = Image::Imlib2->load("$dir/face.jpg");
$image->set_quality(100);
my $santa_hat = Image::Imlib2->load("$dir/santa_hat.png");
$image->blend($santa_hat, 1, 0, 0, 300, 300, 0, 0, 300, 300);

$image->save("$dir/with_santa_hat.png");

できた画像

サンタ帽をかぶることができました！簡単ですね！

画像を作成する

サンタ帽をかぶってクリスマスっぽくなりました。もうひといき、今度は星画像を作ってみましょう。

Image::Imlib2::Polygonというモジュールを使って多角形を作ります。

星形は正五角形の頂点を結ぶので、先にShape::RegularPolygonを利用して正五角形の頂点を取得しておきます。

そのあと1つ飛びに頂点を描き、まさに手書きで星を書くときのように描いていきます。

これだけでは中の正五角形が塗られないので、中身も後から塗って星形の完成です。

#!/usr/bin/perl

use strict;
use warnings;
use Data::Dumper;
use Image::Imlib2;
use Shape::RegularPolygon;

my $dir = '/path/to/image';

my $image = Image::Imlib2->new_transparent(100, 100);
$image->set_colour(255, 255, 0, 255);

my $points = &get_points(50);
my $poly = Image::Imlib2::Polygon->new();

for my $point (@$points) {
    $poly->add_point($point->{x}, $point->{y});
}
$poly->fill();

$image->draw_polygon($poly, 1); 
$image->fill(50,50);
$image->save("$dir/star.png");


sub get_points {
    my $center = shift;

    my $polygon = new Shape::RegularPolygon;
    $polygon->center($center, $center);
    $polygon->sides(5);
    $polygon->radius(50);
    my @points = $polygon->points;

    return [$points[0], $points[2], $points[4], $points[1], $points[3], $points[0]];
}

できた画像

できた画像を合成します。

create_rotate_imageで画像を回転させて貼り付けます。

#!/usr/bin/perl

use strict;
use warnings;
use Image::Imlib2;

my $dir = '/path/to/image';

my $image = Image::Imlib2->load("$dir/with_santa_hat.png");
$image->set_quality(100);
my $star = Image::Imlib2->load("$dir/star.png");
$image->blend($star, 1, 0, 0, 100, 100, 0, 200, 100, 100);

my $rotated = $star->create_rotated_image(30 / 360 * 3.141519*2);
$image->blend($rotated, 1, 0, 0, 150, 150, 210, 80, 100, 100);

$image->save("$dir/with_star.png");

できた画像

できました！これでアイコンがにぎやかになりましたね！

まとめ

Image::Imlib2を使うと簡単に画像を加工することができます。ちょっとした画像編集にPerlを使ってみるのはいかがですか？

明日はAdvent Calendarの大トリ、piarraさんです。楽しみですね！

参考

• http://search.cpan.org/~lbrocard/Image-Imlib2-2.03/lib/Image/Imlib2.pm
• http://yusukebe.com/tech/archives/20070526/011710.html
• http://it.kndb.jp/entry/show/id/2572
• http://rakasaka.fc2web.com/delphi/star.html

スレッドを作る

Coroでは、asyncによって新しいスレッドを作ることができます。ただし、asyncでスレッドを作っても、何もしなければ他のスレッドに勝手に処理が移ることはありません。asyncで作成した別のスレッドに制御を移すには、明示的な操作が必要となります。ここではcedeを使って、asyncブロックへ処理を移しましょう。

use strict;
use warnings;
use Coro;

async {
    print "Another thread\n";
};

print "main thread\n";
cede;
print "main thread, again.\n";

__END__

[実行結果]
main thread
Another thread
main thread, again.

cedeを呼んだタイミングでasyncブロックに制御が移り、ブロックを抜けた後にcedeの次の行に制御が戻って来ています。

並行処理させる

次に、いくつかのスレッドを並行処理をさせてみましょう。Coroでの並行処理は、あるスレッドの待ち時間に他のスレッドが動いてくれる、ってのがミソとなります。ここではCoro::Timer::sleepを使ってその原理を見てみます。

use strict;
use warnings;
use Coro;
use Coro::Timer;

my @coros;
for my $sec (1 .. 3){
    push @coros, async {
        print "wait $sec sec.\n";
        Coro::Timer::sleep $sec;
        print "after $sec sec.\n";
    } ;
}
$_->join for @coros;

__END__

[実行結果]
wait 1 sec.
wait 2 sec.
wait 3 sec.
after 1 sec.
after 2 sec.
after 3 sec.

1秒かかる処理、2秒かかる処理、3秒かかる処理を実行してますので、並行処理でなければ6秒かかるはずです。しかし、Coro::Timer::sleepを使っているため、これらのスレッドは並行動作し、このプログラムは3秒で終了します。

実例: URLのダウンロード

sleepするだけでは面白くないので、もう少し具体的な例を見ておきましょう。Coro::LWPを使うと、LWPがCoroを使ってなるべくブロックしないように動くようになります。言い換えると、LWPが、待ち時間になると他のスレッドに処理を移すことで並行動作するようになるということです。

use strict;
use warnings;
use Coro;
use Coro::LWP;
use LWP::UserAgent;

my @coros;
for my $url (
    'http://d.hatena.ne.jp/hiratara/',
    'http://www.google.co.jp/',
    'http://www.yahoo.co.jp/',
){
    push @coros, async {
        my $ua = LWP::UserAgent->new;
        print "load $url\n";
        my $res = $ua->get( $url );
        print "got $url: ", $res->title, "\n";
    };
}
$_->join for @coros;

__END__

[実行結果]
load http://d.hatena.ne.jp/hiratara/
load http://www.google.co.jp/
load http://www.yahoo.co.jp/
got http://www.google.co.jp/: Google
got http://www.yahoo.co.jp/: Yahoo! JAPAN
got http://d.hatena.ne.jp/hiratara/: a geek born in Tomakomai

全てのコンテンツの読み込みが同時にスタートし、並行して読み込みが行われていることがわかると思います。use Coro::LWPの部分をコメントにして動かした場合と結果を比較すると、より並行動作していることがはっきりするでしょう。

なお、非同期でHTTPアクセスを行うモジュールとしては、Coroの作者が作ったAnyEvent::HTTPというモジュールもあり、こちらのほうがよいとされています。ただし、Coro::LWPを使うと、LWPを使ったMechanizeやWeb::Scraperもそのまま動くという利点もありますので、ケースバイケースで選択するのがよいと思います。

実行の制御

Coroのスレッドは、scheduleを呼ぶと眠り、readyで起こされると再び動き始めます。この働きをそのまま利用して実行の順番を調整することもできますが、これは大変です。例えば、以下のコードでは、他のスレッドに勝手にメインスレッドが起こされてしまっており、Doneの出力処理が実行されていません。

async {
	# The evil thread
	$Coro::main->ready;
};

my $done = $Coro::current;

async {
    print "Please wait.\n";
    cede;
    print "Done\n";
    $done->ready;
};

print "main thread\n";
schedule;
print "main thread, again.\n";

__END__
[実行結果]
main thread
Please wait.
main thread, again.

このような場合、Coroが用意しているロックの機構を利用し、実行の順序を明示的に指示する必要があります。例えば、Signalを使うと、この処理は以下のように書けます。

async {
	# The evil thread
	$Coro::main->ready;
};

my $done = Coro::Signal->new;

async {
    print "Please wait.\n";
    cede;
    print "Done\n";
    $done->send;
};

print "main thread\n";
$done->wait;
print "main thread, again.\n";

__END__
[実行結果]
main thread
Please wait.
Done
main thread, again.

waitメソッドは、sendが呼ばれるまでブロックします。そして、asyncブロックからsendを送ったタイミングで、メインスレッドのロックが解除されて再び動き出します。

また、カウンター付きのロックが必要な場合は、Semaphoreを使います。Signalのwaitの代わりに、downを使ってブロックさせることができます。downは文字通りカウンタの値を1減らすメソッドですが、カウンタが0以下の時はブロックして正の値になるのを待ちます。そして、ブロックしているSemaphoreを起こすにはupを呼びます。

以下の例では負(正確には0以下)の値のセマフォを作り、3つのプロセスが全て終了するのを待っています。

my $num = 3;
my $semaphore = Coro::Semaphore->new( 1 - $num );

for my $i ( 1 .. $num ) {
    async {
        Coro::Timer::sleep $i;
        print "After $i sec.\n";
        $semaphore->up;
    } ;
}

$semaphore->down;
print "Finished\n";

ここでAnyEventのcondvarに慣れている方であれば、beginとendのようなことをしたいと考えるかもしれませんが、downメソッドは0以下値の時はブロックするので、beginの代わりには使えません。この場合、負の値でもブロックしないadjustメソッドを使うことができます。

my $semaphore = Coro::Semaphore->new;

for my $i ( 1 .. 3 ) {
    $semaphore->adjust( -1 );
    async {
        Coro::Timer::sleep $i;
        print "After $i sec.\n";
        $semaphore->up;
    } ;
}

$semaphore->down;
print "Finished\n";

これとは逆に正の値のセマフォは、同時に走る処理の数を制御するのに便利です。以下の例では、2個しかないリソースを10個のスレッドが奪い合っていますが、セマフォによってリソースに同時に触れるスレッドを制限しています。

my $lock = Coro::Semaphore->new( 2 );
my @resources = ( 'A', 'B' );

for (1 .. 10) {
    async {
        $lock->down;
        my $resource = shift @resources or die "Depleted energy source.";

        print "Got $resource.\n";
        Coro::Timer::sleep 1;  # Using the resource

        print "Finished using $resource.\n";
        push @resources, $resource;
        $lock->up;
    };
}

schedule;
# Never end.

なお、この処理はguardメソッドを使って以下のように書くこともできます。

    async {
        my $guard = $lock->guard;
        my $resource = shift @resources or die "Depleted energy source.";

        print "Got $resource.\n";
        Coro::Timer::sleep 1;  # Using the resource

        print "Finished using $resource.\n";
        push @resources, $resource;
    };

この書き方をすると、セマフォのupのし忘れを防ぐことができます。ただしこの場合でも、upは確実に実行されてもリソースの解放処理が必ず走るわけではないので、Guardクラスを使って適切なガードを書く方が無難かもしれません。

スレッド間でのデータのやりとり

スレッドが、処理した結果を返すにはterminateを使います。そして、その結果を受け取るにはjoinを使います。

my $coro = async {
	terminate "From the other thread";
};

print $coro->join, "\n";

__END__

[実行結果]
From the other thread

この例では明示的にterminateを呼んでいますが、asyncブロックは戻り値を渡してterminateを呼ぶように自動的にラップされるので、単にreturnで値を返してもjoinで値を受けることができます。

また、別のスレッドからcancelでスレッドをterminateさせることもできますが、この時に終了値を外のスレッドから渡すことが出来ます。

my $coro = async {
	print "Wait 10 sec.\n";
	Coro::Timer::sleep 10;
	terminate "From the other thread";
};

async {
	Coro::Timer::sleep 1;
	$coro->cancel( "Terminated" );
};

print $coro->join, "\n";

__END__

[実行結果]
Wait 10 sec.
Terminated

ただし、terminateとjoinでは、1つのスレッドから複数回値を返すことはできません。特にスレッドプールを使う場合には、スレッドが終了しないのでjoinが使えません。そこで、スレッド間でもっと自由にデータをやりとりする道具として、Coro::Channelがあります。Coro::Channelを使うと、簡単にスレッド間でデータのやり取りをすることができます。

my $ch = Coro::Channel->new;

async {
	$ch->put($_) for qw/one two three DAAAAA!/;
	$ch->shutdown;
};

while( my $got = $ch->get ){
	print $got, "\n";
}

__END__

[実行結果]
one
two
three
DAAAAA!

Coro::Channelの動作を、ブロッキングキューと見なすこともできます。デフォルトでは、大きさに制限のないキューとして振る舞います。つまり、putはブロックせず、getはキューが空の時だけブロックします。また、コンストラクタに値を与えることで、大きさ制限のあるキューとして利用することもできます。

スレッドへの割り込み

cancelで他のスレッドを終了させることができることを紹介しましたが、スレッドを終了せずに割り込みをかけることもできます。そのためには、throwを使います。

別のスレッドに対してthrowを呼ぶと、あたかもthrowを呼ばれたスレッドの中でdieが起こったように動作します。evalでブロックする処理を包んだ状態にしておけば、外からthrowで投げられた例外をキャッチすることができます。

use Try::Tiny;

my $done = Coro::Signal->new;

my $worker = async {
	# The worker
	try {
		while () {
			print "In the loop.\n";
			Coro::Timer::sleep 1;
		}
	}catch{
		if( /interrupted/ ){
			print "Interrupted by anyone.\n";
			$done->send;
		}else{
			die $_;
		}
	};
};

async {
	# An interrupter
	print "Wait 3 seconds.\n";
	Coro::Timer::sleep 3;
	print "Interrupt.\n";
	$worker->throw( 'interrupted' );
};

$done->wait;

__END__
[結果]
In the loop.
Wait 3 seconds.
In the loop.
In the loop.
Interrupt.
Interrupted by anyone.

その他の話題

このエントリでは、主にCoroの制御について説明しました。実際にCoroを使う場合は、主にIOの待ち時間を有効利用させることになります。Coroに対応したIOとしては、Coro::Handle、Coro::Socket、Coro::AIOなどがありますので、こちらを参照して下さい。

また、CoroはAnyEventに対応したモジュールにおいて、コールバックが戻ってくるまでの待ち時間を有効利用するためにも使えます。CoroとAnyEventを組み合わせて使う方法についてはこちらのエントリやこちらのエントリも参照して下さい。

そして、たくさんのスレッドを扱う場合に有効な手段となるスレッドプールに関しては、こちらのエントリも参照して下さい。

まとめ

Coroでスレッドを作り、並行動作させることができます。I/O待ちなどによってブロックが多く発生するプログラムでは、Coroによって動作速度を改善できるでしょう。

明日はあのAcme大全の著者、makamaka_at_donzokoさんです。とても楽しみですね！

参考リンク

• Coro::Intro和訳

はじめに

まず、冒頭からアダルティな文字列が出てきます。苦手な人は戻って違うページを見て下さい。

世の中にはalias acotie="rm -rf ./*"などと設定されているすばらしい常識人もいらっしゃるようなので

見習って癒し系aliasを作ってみました。

インストール

Acme::Oppaiモジュールのインストール

sudo cpan -i Acme::Oppai

.bashrcに追記

alias yappo="perl -MAcme::Oppai -e 'print Acme::Oppai->oppai('your')->oppai('soul')->oppai('message')->oppai;';"

$ source ~/.bashrc
$ yappo

　 _ 　∩
(　゜∀゜)彡　your


(　゜∀゜)彡　soul
　⊂彡
　 _ 　∩
(　゜∀゜)彡　message


(　゜∀゜)彡　おっぱい!
　⊂彡

余談ですが、Acme::Oppai-0.03よりnew()時にdefaultオプションが設定できるようになっていました。

default => 'default'の場合

perl -MAcme::Oppai -e 'print Acme::Oppai->new(default => 'default')->oppai';

　 _ 　∩
(　゜∀゜)彡　おっぱい!おっぱい!
　⊂彡

default => 'up'の場合

perl -MAcme::Oppai -e 'print Acme::Oppai->new(default => 'up')->oppai->oppai->oppai';

　 _ 　∩
(　゜∀゜)彡　おっぱい!

default => 'down'の場合

perl -MAcme::Oppai -e 'print Acme::Oppai->new(default => 'down')->oppai->oppai->oppai';

(　゜∀゜)彡　おっぱい!
　⊂彡

文字を入れることもできます！

perl -MAcme::Oppai -e 'print Acme::Oppai->Oppai("Perl")->Oppai("Advent Calendar")->Oppai("2009!")';

　　　 _ 　∩
　　(　゜∀゜)彡　Perl
　　(　 　　|　
　 　|　　　|　
　 　し ⌒Ｊ
　　　 _ 　
　　(　゜∀゜)　　Advent Calendar
　　(　 ⊂彡
　 　|　　　|　
　 　し ⌒Ｊ
　　　 _ 　∩
　　(　゜∀゜)彡　2009!
　　(　 　　|　
　 　|　　　|　
　 　し ⌒Ｊ

まとめ

Oppaiメソッド名の最初の文字を大文字にすると大きいAA、小文字だと小さいAAに変更することができます。

ストレスが溜まりやすい現代社会に、日常生活の癒しとしてAAを導入されてみてはいかがでしょうか。

明日は、Perl業界の最速レポーターなhirataraさんです！是非お楽しみに！

use Plack::Server::CGI;

my $app = sub {
    my $env = shift;
        return [
            200, 
            [ 'Content-Type' => 'text/plain' ],
            [ "Hello stranger from $env->{REMOTE_ADDR}!"],
        ];
};

Plack::Server::CGI->new->run( $app );

Plack::Request

use Plack::Server::CGI;
use Plack::Request;

my $app = sub {
    my $env = shift;
    my $req = Plack::Request->new($env);
    my $res = $req->new_response(
        200,
        [ 'Content-Type' => 'text/html; charset=utf-8' ]
    ); # レスポンスオブジェクト作成
    $res->body("<h1>Hello, World</h1>");
    return $res->finalize;
};

Plack::Server::CGI->new->run( $app );

注目すべきは、$res->body(...)ですね。

こうして、レスポンスオブジェクトを作成するようにすれば、

あとは皆様のご自由にWebApplicationを作れますね。

この$appのところをMyApp->new()->psgi_handler()みたいに渡せば

あとはそのモジュールでPSGIのルールに沿ったロジックを作ればいいですね。

これらのモジュールがあることで、

人それぞれのWeb Application Frameworkを作るのがとてもとても簡単になりました。

今回はCGIで紹介しましたが、

このPlackを使って作成したモジュールはちゃんと作れば、

違うplatform(mod_perl, FCGI....etc)でそのまま動くようになります！

それでは皆様素敵なPlackライフを！

追伸: 最近BLOGを移行したので、宣伝させてくださいm(_ _)m

のぶじゃすのBLOG(http://blog.noble-jasper.com)

2009/12/21 追記:

Plack作者であるmiyagawa氏にはてぶでコメントをいただいた為、追記します。

miyagawa この例なら HTTP::Engine でよい http://twitter.com/miyagawa/status/6859126674

というコメントをいただき、恐る恐るリンクをクリックしてみると、

Switching from $framework to Plack::Request makes NO sense. Stop publishing blog posts like that and confusing people "Plack is a framework"

この例だけではセンスがないと言われてしまいました。

「Plackはフレームワークだ！」って書き方は止めましょうと。

実を言うとHTTP::Engineはあまり詳しくないのですが、

Plack Advent Calendar を熟読し、Plackを再認識しまして。

追記をさせていただきます。

miyagawa氏が

http://advent.plackperl.org/2009/12/day-14-use-plackrequest.html

ここで下記のように言っている通り、

Directly using Plack::Request in the .psgi code is quite handy to quickly write and test your code but not really recommended for a large scale application. It's exactly like writing a 1000 lines of .cgi script where you could factor out the application code into a module (.pm files). The same thing applies to .psgi file: it's best to create an application class by using and possibly extending Plack::Request, and then have just a few lines of code in .psgi file with Plack::Builder to configure middleware components.

大規模プロジェクトにおいて、

Plack::Requestを使って.psgiファイル(実際に実行されるファイル)にコードを書いて、

手軽にやるのは推奨されていないそうです。

アプリケーションレイヤーのコードを(.pmファイルなどのモジュール群に)Plack::Requestで記述し、

.psgiファイルにはPlack::Builderを使って少ないコードでそれらを操作する事が良いそうです。

(日本語訳の解釈が間違っていましたらつっこみください。自信ないですw)

せっかくのAdvent Calendarの記事だったのですが、作者から「あんまり良くなさそう」なコメントを頂いたので、とりあえず加筆しておきました。

今後Plackに関してはもっと自分でも勉強し、どこか(自分のBLOG等)にまとめて書きます。

というかmiyagawaさんの英文のPlack Advent Calendarを読むのがすごくためになると思います。

Log::Dispatch

Log::Dispatch はログの出力先を標準エラーやファイルへの書き込み、メールで飛ばしたり、DBI で DB に突っ込んだり、と Log::Dispatch::* を指定して切り替えられる便利 logger です。

use Log::Dispatch;
use Log::Dispatch::File;

my $dispatcher = Log::Dispatch->new;
# ファイルへの出力
$dispatcher->add(
    Log::Dispatch::File->new(
        name      => 'file1',
        min_level => 'debug',
        filename  => 'logfile',
        mode      => 'append'
    )
);

$dispatcher->log( level => 'alert', message => 'Advent Calendar の締め切りが近い！ >_<');
# => logfile に Advent Calendar の締め切りが近い！ >_< と追記される

使いたい Log::Dispatch::* オブジェクトを add メソッドでどんどん追加できます。

use Log::Dispatch::Screen;

# Screen への出力も追加
$dispatcher->add(
    Log::Dispatch::Screen->new(
        name      => 'screen',
        min_level => 'debug',
        stderr    => 1
    )
);
$dispatcher->log( level => 'warning', message => 'ファイルと画面に出力されるよ');
# => 標準エラーに出力されつつファイルにも出力されます。

min_level はその Log::Dispatch::* オブジェクトが出力する最小のレベルです。max_level というオプションもあって、そちらは最大のレベルですね。

use Log::Dispatch;
use Log::Dispatch::Screen;

my $dispatcher = Log::Dispatch->new;

# min_level notice
$dispatcher->add(
    Log::Dispatch::Screen->new(
        name      => 'screen1',
        min_level => 'notice',
        stderr    => 1
    )
);

# max_level error
$dispatcher->add(
    Log::Dispatch::Screen->new(
        name      => 'screen2',
        min_level => 'debug',
        max_level => 'error',
        stderr    => 1
    )
);

$dispatcher->log( level => 'warning', message => 'notice ~ error なので2回表示される');
$dispatcher->log( level => 'debug', message => 'notice 以下なので1回だけ');
$dispatcher->log( level => 'emergency', message => 'error 以上なので1回だけ');

Log::Dispatch::Config

Log::Dispatch::Config を使うと Log::Dispatch::* オブジェクトの追加とかを Config に書き出せておけます。

プログラムの方はこんな感じで書いておいて、

use Log::Dispatch::Config;

Log::Dispatch::Config->configure('log.conf');
my $dispatcher = Log::Dispatch::Config->instance;
$dispatcher->debug('デバッグログですよ');

指定した設定ファイルの方を以下の様に書くと

dispatchers = file screen

file.class = Log::Dispatch::File
file.min_level = debug
file.filename = logfile
file.mode = append
file.format = [%d] [%p] %m at %F line %L%n

screen.class = Log::Dispatch::Screen
screen.min_level = debug
screen.stderr = 1
screen.format = %m

最初に示した例と同じようにファイルと標準エラーへの出力がされます。
dispatchers には用意した設定で使わない設定を外すとその設定は使用されなくなります。便利ですね。

Log::Dispatch::Config はいくつかの Configurator があるので XML や YAML 形式でも使えます。

Log::Dispatch::Screen::Color

さて本題です！

色々書いてるうちに Log::Dispatch の話題がほとんどになってしまいましたが、Log::Dispatch::Screen::Color で色をつけて終わりにしましょう。

せっかくなので Log::Dispatch::Configurator::YAML を使って YAML で設定を示しましょう。

use Log::Dispatch::Config;
use Log::Dispatch::Configurator::YAML;

my $config = Log::Dispatch::Configurator::YAML->new('log.yaml');
Log::Dispatch::Config->configure($config);
my $log = Log::Dispatch::Config->instance;

設定はこんな感じ。

dispatchers:
  - color
color:
  class: Log::Dispatch::Screen::Color
  min_level: debug
  stderr: 1
  format: '[%d] [%p] %m at %F line %L%n'
  color:
    info:
      text: green
    warning:
      text: yellow
    error:
      text: red
    alert:
      text: red
      background: white
      bold: 1

そしてログを吐いてみます。

$log->info('info message is green!');
$log->warning('warning message is yellow!');
$log->error('error message is red!');
$log->alert('alert message is red on white!');

色ついた！

ログに色がつくと開発時とかわかりやすくて良いです。

ちなみに Log::Dispatch で色をつけるモジュールは拙作の Log::Dispatch::Colorful なんてのもありますが、こっちは変数の dump もしたくて Log::Dispatch 自体にも手を加えてしまい、他の Log::Dispatch::* との共存がしづらくなります。

色をつけたいだけなら、Yappo さん作のこの Log::Dispatch::Screen::Color をお薦めします。Windows 環境でも色が着くようです。

Catalyst でお手軽に色をつけたければ Catalyst::Plugin::Log::Colorful なんてのもあります。

Term::ANSIColor 使えばエスケープシーケンスを意識しなくても出力に色がつけられるので、他の Logger で色つけたいという方はモジュール作ってみてはいかがでしょうか！
（Log::Dispatch::Screen::Color は Win32::Console::ANSI 使って windows 対策してますね）

% cpan LWP Crypt::SSLeay

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

my $http_proxy = "http://forward_proxy:8080/";

my $ua = LWP::UserAgent->new;

# proxyメソッドを使う場合
$ua->proxy([qw(http https)], $http_proxy);

# 環境変数から読み込む場合
$ENV{HTTP_PROXY}  = $http_proxy;
$ENV{HTTPS_PROXY} = $http_proxy;

$ua->env_proxy;

my $res = $ua->get(shift);

print $res->dump;

% perl proxy_sample1.pl http://http_host/
% perl proxy_sample1.pl https://https_host/

HTTP/1.0 501 Not Implemented

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

# Crypt::SSLeayでは最後に"/"が付いてるとダメ
my $http_proxy = "http://forward_proxy:8080";

my $ua = LWP::UserAgent->new;

# proxyメソッドを使う(HTTPの場合)
$ua->proxy([qw(http)], $http_proxy);

# 環境変数から読み込む(HTTPSの場合)
$ENV{HTTPS_PROXY} = $http_proxy;

$ua->env_proxy;

my $res = $ua->get(shift);

print $res->dump;

% perl proxy_sample2.pl http://http_host/
% perl proxy_sample2.pl https://https_host/

なぜLWP::UserAgentではHTTPSをProxyできないのか

なんとかProxyすることはできましたが、そもそも同じProxyを経由するのに同じ指定の仕方ができない理由は何か。LWPではだめなのか。

この挙動の原因はLWP::UserAgent::send_requestメソッドの以下のコードにありました。

sub send_request
{
    my($self, $request, $arg, $size) = @_;
    my($method, $url) = ($request->method, $request->uri);
    my $scheme = $url->scheme;

    local($SIG{__DIE__});  # protect against user defined die handlers

    $self->progress("begin", $request);

    my $response = $self->run_handlers("request_send", $request);

    unless ($response) {
        my $protocol;

        {
            # Honor object-specific restrictions by forcing protocol objects
            #  into class LWP::Protocol::nogo.
            my $x;
            if($x = $self->protocols_allowed) {
                if (grep lc($_) eq $scheme, @$x) {
                }
                else {
                    require LWP::Protocol::nogo;
                    $protocol = LWP::Protocol::nogo->new;
                }
            }
            elsif ($x = $self->protocols_forbidden) {
                if(grep lc($_) eq $scheme, @$x) {
                    require LWP::Protocol::nogo;
                    $protocol = LWP::Protocol::nogo->new;
                }
            }
            # else fall thru and create the protocol object normally
        }

        # Locate protocol to use
        my $proxy = $request->{proxy};
        if ($proxy) {
            $scheme = $proxy->scheme;
        }

        unless ($protocol) {
            $protocol = eval { LWP::Protocol::create($scheme, $self) };
            if ($@) {
                ... snip ...

• HTTPSリクエストでProxyなし
  • $protocolがLWP::Protocol::httpsのインスタンスになる
• HTTPSリクエストでProxyあり(Proxyの$schemeがHTTP)
  • $protocolがLWP::Protocol::httpのインスタンスになる

つまり、HTTPSリクエストでProxyありのときでも$protocolがLWP::Protocol::httpsのインスタンスになるようにすれば、HTTPリクエストもHTTPSリクエストも扱えそうですね！

そこで以下のコードを書いてみました。モジュール名はいい名前が思いつかなかったので適当です。

package LWP::UserAgent::ProxyConnect;

use strict;
use warnings;
our $VERSION = '0.01';

use LWP::UserAgent ();

{
    my $impclass = LWP::Protocol::implementor('http');

    my $orig = $impclass->can('request');

    my $proxy_method = sub {
        my ($self, $request, $proxy, $arg, $size, $timeout) = @_;

        # $request->url->schemeが'https'で$proxyがあるとき
        if ($request->url->scheme eq 'https' and $proxy) {
            # Crypt::SSLeayのために環境変数をセットして
            local $ENV{HTTPS_PROXY} = $proxy->host_port;

            no warnings 'uninitialized';
            my ($username, $password) = split /:/, $proxy->userinfo;
            local $ENV{HTTPS_PROXY_USERNAME} = $username;
            local $ENV{HTTPS_PROXY_PASSWORD} = $password;
            use warnings 'uninitialized';

            # $selfをLWP::Protocol::httpsのインスタンスにして
            bless $self, LWP::Protocol::implementor('https');

            # $proxyをなしにして元の処理に戻る
            $orig->($self, $request, undef, $arg, $size, $timeout);
        }
        else {
            goto $orig;
        }
    };

    no strict 'refs';
    no warnings 'redefine';
    *{"${impclass}::request"} = $proxy_method;
}

1;

LWP::UserAgentと同じように使えます。

#!/usr/bin/perl
use strict;
use warnings;
use LWP::UserAgent::ProxyConnect;

my $ua = LWP::UserAgent->new;

# 環境変数にセットしていればこれだけで両方ともOK
$ua->env_proxy;

my $res = $ua->get(shift);

print $res->dump;

これでリクエストがHTTPかHTTPSかを気にせずProxyを指定できるようになりました！やったね！

参考

• Perlから、https(SSL)のコンテンツをProxy経由で取得する - ragutarouの日記
• LWP::UserAgent::env_proxy - masakiのはてなダイアリー

さてさて、JPerl Advent Calendar 2009もいよいよ後半に突入ですね。

明日はvkgtaroさんです！わくてか！

Support Vector Machine（SVM）はどんなことをしてくれるの？

Support Vector Machine はパターン認識のための手法です。

SVM を分かりやすく説明するのは、思わず放棄したくなるほど困難なことなのですが、頑張ってみます。

たとえば、床にばらまかれた沢山のボールがあるとします。

ボールが落ちている位置に基づいて、すべてのボールを 2 つのバケツのどちらかに分けようと思います。

ボールの分け方には様々な方法があると思うのですが、

SVM による分け方は、ボール分けるときにロープを一直線に床に置いて、

ボールがロープより右にあるか左にあるかでバケツを分けるような分け方です。

大変にいい加減な図ですが、こんな図を思い浮かべてください。

       o
 o 　　
     o    o
--------------
  o      o
       o
            o

ロープの置き方は、なんでも良い、というわけではありません。

ボールを分けたときに、ロープの左右にあるボールとロープの距離の合計が最大となるようなロープの置き方をします。

ボールの位置が変わったときでも、このロープの置き方のルールを適用すれば、ボールは迷わずに 2 つのバケツに分けることができます。

ところで、もしもボールが明らかに 2 色にだけ別れているなら、以下のように分かれていても大丈夫な気分がしますね。

       o
 o 　　
     o    o
--------------
  x      x
       x
            x

では、ボールがこんな感じでバラまかれていたら、どこにロープを置くのでしょうか。

       x
 o 　　
     o    o

  x      x
       x
            o

なんというか、どうやってロープを置いても、まっすぐに置く限りは上手く2つのバケツに分けられなさそうですよね。

でも、もしも上の図が実は2次元の図ではなく3次元の図だったらどうでしょうか。

図を回転してあげたら、ロープをまっすぐ引いてボールを綺麗に分けられるような位置を見つけられるかもしれません。

SVM のすごいところは、これらのボールを何とか分けられるような空間にボールを写像して、なんとか線を引いてしまいます。

   x  |  
      |  o
      |   oo
      |
  xx  |   
   x  |  
      |   o

で、たとえば、こんな感じで線を引いてしまうのです。SVM にちょっと興味が出てきましたか？

ほんのりと SVM のことが分かってもらえれば、この説明は成功です。

SVM についてちゃんと知りたい方は、キチンと別の文献を読んで理解をし直してください。

今回ご紹介するモジュール「Algorithm::SVMLight」

今回、ご紹介する「Algorithm::SVMLight」は CPAN にある SVM 向けの Perl モジュールのうち、一番ちゃんと動きそうだから選びました。

でも、多少試行錯誤しないとインストールできなかったのでネタとして丁度良かったです。

インストールできなくて諦めてしまう人も多いかと思いますので、この記事を読んでガンバってみてください。

「Algorithm::SVMLight」を使うと何が嬉しいのか

SVMlightをPerlから扱えると何が嬉しいのかというと、インスタンスの読み込み、学習の実行、モデルの書き出し・読み込み、分類結果の取得などの動作を、Perl で書いたアプリケーションの任意の位置で実行できる点にあるのかな、と思います。

分類対象のデータを素性エンコーディングして、即、SVMlight で分類しようと思うようなときには、SVMlight が Perl から扱えると嬉しいです。分類結果を出力したあと、改めて素性エンコードする前のデータに結果に適用しようとすると、面倒くさいことが多いです。

Algorithm::SVMLight の作者である Ken Williams は、このモジュールにファイルからの分類対象データの読み込み処理を書いていません。「分類対象のデータに関しては Perl で扱え！」ということですかね。。。

ちなみに、学習データを SVM の学習用の素性にエンコードする処理に関しては SVMlight とは無関係に書けます。

でも、このエンコーディング処理は複雑になりがちなので、もろもろ柔軟な Perl はかなり重宝します。

SVM light と、Algorithm::SVMLight のインストール

SVMlightの最新のソースコードは以下のURLからダウンロードできます。

• http://svmlight.joachims.org/

今回、利用したソースコードは以下から取得しました。

• http://download.joachims.org/svm_light/current/svm_light.tar.gz

その後は、以下のようにしてインストールしました。適時 sudo してください。

% wget http://search.cpan.org/CPAN/authors/id/K/KW/KWILLIAMS/Algorithm-SVMLight-0.09.tar.gz
% tar xfvz Algorithm-SVMLight-0.09.tar.gz
% mkdir ./svm_light
% cd ./svm_light
% wget http://download.joachims.org/svm_light/current/svm_light.tar.gz
% tar xfvz svm_light.tar.gz
% patch -p1 < ../Algorithm-SVMLight-0.09/SVMLight.patch
% make all
% mkdir /usr/local/bin/svm_light/
% cp ./svm_learn /usr/local/bin/svm_light/
% cp ./svm_classify /usr/local/bin/svm_light/
% mkdir /usr/local/include/svm_light/
% cp ./svm_learn.h /usr/local/include/svm_light/
% cp ./svm_common.h /usr/local/include/svm_light/
% cp ./libsvmlight.a /usr/local/lib
% cp ./libsvmlight.so /usr/local/lib
% ldconfig
% cd ../Algorithm-SVMLight-0.09/

バイナリファイルの名前を変えてコピーしているのは、変更前のファイル名が TinySVM と同じだったからです。

でも、このままだと Algorithm::SVMLight のコンパイル中に、SVMlight のヘッダファイルが見つからなくてエラーが出てしまいました。

仕方がないので、エディタで Algorithm-SVMLight-0.09/lib/Algorithm/SVMLight.c の 30・31 行目を編集し

#include "svm_common.h"
#include "svm_learn.h"

に、ヘッダの絶対パスを追記して、

#include "/usr/local/include/svm_light/svm_common.h"
#include "/usr/local/include/svm_light/svm_learn.h"

にしました。

あとは、以下を実行するだけでした。

% perl Makefile.PL
% perl Build
% perl Build test 
% perl Build install

これで SVMlight のインストールが終わり、Perl スクリプトからは Algorithm::SVMLight が使えます。

SVMlight の素性エンコード

一番面倒なのが、データを素性形式にエンコード部分です。

素性の文字列表現と番号を対応づけるコードは、一回書くと使い回しが効いて楽です。

例えば以下のように実行できるエンコーダーを書いてしまって、

% perl feature_encoder.pl "入力の学習データファイルのパス" "出力の素性エンコード済みデータファイルのパス"

その後で、素性の作り方を工夫してみるのはどうでしょうか。

feature_encoder.plの例

#!/usr/bin/perl

use strict;
use warnings;
use utf8;

use Encode;

use TokyoCabinet;
use MeCab;

# MeCabオブジェクト
my @mecab_opt = ();
my $mecab = new MeCab::Tagger(join " ", @mecab_opt);

my $inputdata = $ARGV[0];
my $outputdata = $ARGV[1];
my ($in, $out);

# TokyoCabinetの初期化
my $tchdb_file_path  = $FindBin::Bin."/../feature_num.tch";
my $hdb  =  TokyoCabinet::HDB->new();
$hdb->tune(2000000);
$hdb->open($tchdb_file_path, $hdb->OWRITER | $hdb->OCREAT | $hdb->OREADER);

# 素性番号カウンタ
my $gloval_counter = 1;
# 素性番号カウンタの値をHDBから取り出すためのキー
my $gkey = "GLOBALCOUNTER";

# 素性番号カウンタの値を取得
my $tmp_gloval_counter = $hdb->get($gkey);
if (defined $tmp_gloval_counter) {
    $gloval_counter = $tmp_gloval_counter;
}
else {
    # 取得できなかったら初期値「1」を登録
    $hdb->put($gkey, 1);
    $gloval_counter = 1;
}

open ($in, "< $inputdata");
open ($out, ">> $outputdata");

# 素性の書き出し
while(my $line = <$in>){
    chomp $line;
    next unless ($line);
    # MeCabの結果を取得する
    my @mecab_arr = @{get_mecab_result_arr($line)};
    next unless (@mecab_arr);
    my $count = 0;
    
    # ラベル
    my $label = 0;

    # 出力用に素性番号を突っ込む配列
    my @feature_arr  =  ();
    
    # 素性の材料を得る
    my $entry = $mecab_arr[$i];
    my $key = $entry->[0];
    my $pos = $entry->[1];
    my $keypos = "$key:-:$pos";

    # 素性番号の取得と登録
    my @keyarr = ($key, $pos, $keypos);
    foreach my $k (@keyarr) {
         # 素性番号を取得してみる
         my $tmp_feature_num = $hdb->get($k);
         my $feature_num = 0;
         if (defined $tmp_feature_num) {
             # 取得できたら、そのまま出力用の配列に突っ込む
             push @feature_arr, "$tmp_feature_num";
	 }
	 else {
             # 取得できなかったら、素性番号カウンタの値を取得
	     $feature_num = $gloval_counter;
             # カウンタの値を、キーに対する素性番号にして登録
             $hdb->put($k, $feature_num);
             # 素性番号カウンタ++
             $gloval_counter++;
             # 素性番号カウンタのバックアップ
             $hdb->put($gkey, $gloval_counter);
             push @feature_arr, "$feature_num";
	 }
    }

    # ソート、ユニークする。
    @feature_arr  =  sort {$a < = > $b} @feature_arr;
    my $x   =   '-';
    my @uniq_arr  =  grep( $_ ne $x && ($x  =  $_), @feature_arr);
    # この例では、最後に全ての素性に一様な重みをつけている
    my $features  =  join ":0.1 ", @uniq_arr;
    my $entry  =  "$label $features:0.1\n";
    print $out $entry;

}
close ($out);
close ($in);
$hdb->close();

# 1行のテキストを受け取り、MeCabでparseしたあと、結果を配列に入れて返す。
sub get_mecab_result_arr {
    my ($line)  =  @_;
    my $parsed  =  $mecab->parse($line);
    $parsed  =  decode_utf8($parsed) unless utf8::is_utf8($parsed);
    my @pos_arr  =  split('\n', $parsed);
    my @result  =  ();
    if(@pos_arr){
        my $i  =  0;
        foreach my $pos (@pos_arr){
            my @info_arr  =  split(/\t/, $pos);
            my @mecab_arr  =  split(/\,/, $info_arr[1]);
            my @mec  =  ($info_arr[0], @mecab_arr);
            $result[$i]  =  \@mec;
            $i++;
        }
    }
    return \@result;
}

このファイルの中には TokyoCabinetを使った素性番号管理と、MeCab を使った形態素解析の処理が含まれています。

TokyoCabinetのHDBに、現在の素性番号の最大値を格納してあるので、追加も楽にできます。

SVMlight の素性エンコード時の注意点

SVMlight に素性エンコードしたインスタンスを読み込ませるには、以下のような注意が必要です。

• インスタンス中の素性番号は昇順に並べること
  • 良い例：-1 10:0.1 20:0.2 30:0.3
  • 悪い例：-1 10:0.1 40:0.4 30:0.3
• インスタンス中の素性番号はユニークにすること
  • 良い例：-1 10:0.1 20:0.2 30:0.3
  • 悪い例：-1 10:0.1 20:0.2 20:0.3
• 学習データ以外の、分類対象のデータをエンコードする場合にもラベルを付与する

Algorithm::SVMLight を使ったモデル構築

Algorithm::SVMLight を使うと、モデルの構築は例えば以下のように書けます。

% perl ./make_model.pl "入力のインスタンスファイルのパス" "出力のモデルファイルのパス"

素性にエンコード済みなインスタンスファイルを用意できれば、上記を実行してあげるとモデルが得られます。

make_model.pl の例

#!/usr/bin/perl

use strict;
use warnings;
use utf8;

# オブジェクト作成
use Algorithm::SVMLight;
my $svm = new Algorithm::SVMLight;

# 入出力ファイルのパス
my $inputdata = $ARGV[0];
my $outputdata = $ARGV[1];

# インスタンスの読み込み
$svm->read_instances($inputdata);
# 学習開始
$svm->train();
# モデルの書き出し
$svm->write_model($outputdata);

Algorithm::SVMLight があれば、モデル構築以外の処理も Perl で手軽に書けます。

まとめ

今回は SVMLight の Perl モジュールである Algorithm::SVMLight をインストールしました。

SVM は使いどころを間違えなければ大変に便利です。SVM を扱った学術論文は多数あるので、そちらもご覧下さい。

さてさて、明日は pixiv のエンジニアである kamipo さんです。楽しみですね！

EmEditorとは?

Windows専用のテキストエディタであり、性能的には秀丸に比肩する能力を備えています。ただ、コミュニティの差なのか、秀丸に比べるとイマイチマイナーです。秀丸がWindowsテキストエディタ界におけるPerlだとしたら、EmEditorはRubyのような存在といえるでしょう(?)

EmEditorの特長

個人的に優れていると思う点をあげてみます。

• Perl互換の正規表現での検索(秀丸に存在しない\b等も使える)
• 中国語もGrepで引っ掛けられる
• CSV, TSV表示機能がある(Ver.9以降)
• Perlでマクロが書ける

今回は、Perlマクロに関して取り上げます。JScriptで書かれることが多いみたいなのですが、Perlで書けるという事はCPAN使い放題なので、複雑な事も簡単に実現可能なのです。

マクロで何が出来るのか？

百聞は一見にしかずということでまずは以下をご覧下さい。

TwitterTLを表示する

選択範囲内の文字列をPerlコードとして実行・出力する

こんな感じのことができます。上記のように、個人的には

• 選択範囲のテキストを加工したりどこかに送ったり
• 何らかの出力をアウトプットバー(画面の下半分の箇所)に出す

といったことにマクロを活用しています。

作成方法

とりあえず簡単に。

• メニューから[マクロ] -> [カスタマイズ] -> [マイマクロ]タブで[新規作成]を押してファイルを作成
• ファイルの拡張子は.pleeにする

書き出し

以下の通りです。

#language="PerlScript"
our $Window;
 
use strict;
use warnings;
use utf8;

普通のPerlスクリプトとはshebang行の書き方が異なります。$Windowオブジェクトは既にEmEditorマクロ内で定義されているオブジェクトですが、use strictで書く場合は、ourで宣言しておかないと怒られます。

この$Windowオブジェクトを操作することがEmEditorマクロの肝となります。

$Windowオブジェクトについて

EmEditorを弄る上で必要な、多種多様なメソッド・プロパティがぶら下がっています。オブジェクトの仕様に関しては、EmEditorのヘルプに詳細に書かれているので、そちらを参照すると良いでしょう。

ちなみに、EmEditorマクロはもともとVBScriptやJScriptで書かれることを想定しているので、Perlでメソッドやプロパティアクセスをしようとすると多少戸惑う部分があります。

Perlマクロの場合、プロパティアクセスもメソッド呼び出しも、メソッド呼び出しとして記述することが出来ますが、プロパティに値をセットするときには、オブジェクトの実体であるハッシュリファレンスの中を覗かないといけません。

また、真理値をセットする場合には、真を1、偽を0としてセットします。

// JScriptの場合
// アウトプットバーの内容を消す
Window.OutputBar.Clear();
// アウトプットバー非表示の場合、表示する
if ( !Window.OutputBar.visible ){
    Window.OutputBar.visible = true;
}
// アウトプットバーに'hoge'と表示する
Window.OutputBar.writeln('hoge');

# Perlの場合
# アウトプットバーの表示を消す
$Window->OutputBar->Clear;
# アウトプットバー非表示の場合、表示する
$Window->OutputBar->{'visible'} = 1     # ハッシュの中を覗く
    unless $Window->OutputBar->visible; # getterとしては使用可能
# アウトプットバーに'hoge'と表示する
$Window->OutputBar->writeln('hoge');

多分AUTOLOADを使って、メソッドが存在しない場合は、ハッシュエントリーを見に行くようにしているのでしょう。getterとして使用可能なら、$Window->OutputBar->visible(1) とかして、setterとしても使用可能でも良さそうなもんですが、それは出来ないようです。

ちなみに、毎回$Window->...とか書くのがめんどくさかったりする場合は、オブジェクトにアクセスするメソッドはオブジェクト参照を返すので、以下のように書くことが出来ます。当たり前ですが。

my $out_bar = $Window->OutputBar; # $out_barにOutputBarオブジェクトが入る
$out_bar->Clear;
...

選択文字列(selectionオブジェクト)について

プロパティアクセスの説明とともにOutputBarオブジェクトの説明も済ませてしまったので、次はselectionオブジェクトの説明をします。

selectionオブジェクトには、編集中のテキスト内の選択文字列の情報が入ります。OutputBarがマクロにおける出力部分だとしたら、selectionは入力の部分を担います。

以下のようにして選択文字列を取得することが出来ます。

my $code = Encode::decode(
    'cp932',
    $Window->document->selection->Text
);

cp932でデコードしています。日本語Windowsを使っている場合、selection->Textには必ずcp932文字列が入ってしまいす。たとえ、UTF-8のファイルを編集中であっても、その選択文字列は自動的にcp932文字列に変換されてselection->Textに入ってしまうのです。同様に、OutputBarに出力するときもcp932にエンコードしてやらなくてはいけません。

ロケールの問題なのか理由は定かではありませんが、これは非常に困ります。中国語(cp932範囲外の文字)が使えません。

ちなみに、JScriptでマクロを記述する場合には、スクリプトをUTF-8で記述し、BOMをつける事によって、UTF-8をそのまま扱うことが出来ます。つまり、OutputBarに中国語表示が可能です。この点はJScriptの方が優れています。悔しいです。

// JScriptだとUTF-8(BOM付き)で保存すると中国語が表示できる!!!
Window.OutputBar.writeln('你好');

これに関して解決策をご存じの方は、y.songmu at gmail.comまでお知らせ下さい。非常に困っています。

マクロの実例(実践編)

気を取り直して、冒頭でも実行例を表示した、選択文字列をPerlコードとして実行するマクロを記載します。

これは簡単な計算をさせたり、正規表現のチェックをしたりとかなり重宝しています。

至極単純な話で、選択範囲をevalすれば良いだけの話なんですが、print, say文での出力をアウトプットバーに出したいため、IO::Captureモジュールを使って、捕捉した標準(エラー)?出力をアウトプットバーに出力しています。

IO::Captureモジュールはprint文が書かれてもその内容をすぐに出力せず、バッファしておくことができる、非常に便利なモジュールです。(一応モジュールの紹介もしておかないと)

#language="PerlScript"
our $Window;
use strict;
use warnings;
use utf8;
use Encode;
 
use Win32; # ダイアログ表示の為に使用
use IO::Capture::Stdout;
use IO::Capture::Stderr;
 
# 選択範囲のテキストを取得する
my $code = Encode::decode(
    'cp932',
    $Window->document->selection->Text
);
# 中身が空だったり、キャンセルされたら実行しない
exit unless $code;
# 実際はダイアログ表示させて無いんだけど、
# Win32モジュールを使う事も多いので合わせて紹介
exit if Win32::MsgBox('run?', 1) != 1;
 
# 標準(エラー)?出力の捕捉を開始する
my $capture = IO::Capture::Stdout->new;
my $stderr = IO::Capture::Stderr->new;
$capture->start;
$stderr->start;
 
# eval実行する
eval $code;
 
# 捕捉を終了する
$capture->stop;
$stderr->stop;
 
# 結果を出力する前にアウトプットバーの中身をクリアした後、表示
$Window->OutputBar->Clear;
$Window->OutputBar->{'visible'} = 1;

# 標準エラー出力を表示する
# readメソッドは捕捉した順番に出力内容をリストで返してくる
# 表示の際にはcp932でエンコードする
$Window->OutputBar->writeln(
    join "", map { Encode::encode('cp932', $_) } $stderr->read
);
 
$Window->OutputBar->writeln('---');
 
# 標準出力を表示する
$Window->OutputBar->writeln(
    join "", map { Encode::encode('cp932', $_) } $capture->read
);

マクロの実行について

マクロメニューやマクロツールバーからマウスクリックで実行することも出来ますが、よく使うマクロにはショートカットキーを割り当てておくと良いでしょう。私も先程のPerlコード実行マクロには Ctrl+P を割り当てています。

また、メニューを「メニューの変更」から拡張することができます。メニューには Alt+任意のキー でアクセス可能なので、そこからマクロを呼び出したり、階層構造で管理をしたりすることも可能です。Perlの話から逸れるのでここでは多くは書きません。

マクロの使い所

さて、ここまで読んできた方でEmEditor使いの方はもう、マクロをバリバリ書けるようになっていることでしょう。今後どう言ったマクロを書けば良いか、参考までに私が実際に作ったマクロの例を挙げます。

• Twitterに投稿する(と同時にOutputzにも送信する)
• 手元のメモをメールで携帯に送る
• コード(SQL等)を整形する

等々です。外部プログラムとの連携も出来るので、頑張ればiTunesからプレイリストを拾ってきてコンテキストメニューに表示して選択したりなんかもできるようになるみたいです。

皆様も是非、Perlマクロを作ってみて下さい。便利だったら公開してみて下さい。

まとめ

EmEditorでのPerlマクロ開発について駆け足で説明しました。マクロだけじゃなく、正規表現での一括置換なんかも強力なので、WindowでPerlを書くならEmEditorを是非オススメします。

質問、感想、意見なんかは、y.songmu at gmail.com まで連絡くださると嬉しいです。TwitterID: songmu なのでそちら宛につぶやいてくださっても喜びます。

明日はoverlastさんです。お楽しみに！

プログラムの「テスト」

テストを書くというのはデンタルフロスを使うようなもので、誰もが良いことだといいつつ、実際には軽視されがちだ。

なんて言われることもありますが、実際テストがないとプログラムの改修とか引き継ぎとかが非常に大変になりがちです。

また、CPANにアップされているモジュールの中には、モジュール本体よりもテストコードの量の方が多いものも多々あります。

なのでプログラムの質を保証したり、内容を的確に伝達するにはテストが欠かせないものであることは間違いないと思います。

Test::More

Perlのプログラムをテストするための枠組みを提供するモジュールです。

多くのモジュールでこれが使われています。

Test::Moreは5.6.2からコアモジュールに入っているので、最近のPerl環境なら誰でもすぐにテストを始めることができます。

早速使ってみる

例えば消費税の計算をしてくれるConsumptionTax::JPというモジュールを仮定してみます。

このモジュールは、tax_includeという関数に価格を渡すと消費税を付加した価格を返してくれるだけの簡単なお仕事をするクラスです。

が、簡単なお仕事でも間違った値が返ってくると困ってしまいます。

例えば

• 消費税込みの価格は原則小数点以下切り捨てなので、この関数が小数点を含む値を返してしまうことがあってはいけません。
• 小数点が含まれた値を渡した場合、消費税の計算ができませんので、今回は入力された値も小数点以下を切り捨てて扱うこととします。

というようなことは仕様として明確にしておかなければならないでしょう。

今回はそういった「プログラムを書く前に決まる(っている)仕様」を押さえるテストを書いてみましょう。

use strict;
use warnings;

use Test::More;

plan (tests => 5);

# 正しくuseできるかどうか
use_ok("ConsumptionTax::JP");

my $consumption_jp = new ConsumptionTax::JP->new({
    consumption_tax_rate => 0.05,
});

# tax_includeという関数を実装しているか
can_ok($consumption_jp, 'tax_include');

# 小数点以下の出ない値
my $price = 100;

my $price_in_tax = $consumption_jp->tax_include($price);

is($price_in_tax, 105, '期待値と一致');

# 小数点以下が出る値
$price = 128;

$price_in_tax = $consumption_jp->tax_include($price);

is($price_in_tax, 134, '期待値と一致');

# 小数点が含まれる値
my $price_in_point = 100.50;

$price_in_tax = $consumption_jp->tax_include($price_in_point);

is($price_in_tax, 105, '期待値と一致');

テストが書けたら、まずテストを動かしてみましょう。

$ perl t/consumption_tax.t
1..5
not ok 1 - use ConsumptionTax::JP;
#   Failed test 'use ConsumptionTax::JP;'
#   at t/consumption_tax.t line 9.
#     Tried to use 'ConsumptionTax::JP'.
#     Error:  Can't locate ConsumptionTax/JP.pm in @INC (@INC contains: /Users/myfinder/local-lib/lib/perl5/darwin-2level /Users/myfinder/local-lib/lib/perl5 /Users/myfinder/local-lib/lib/perl5/darwin-2level /usr/local/lib/perl5/5.10.1/darwin-2level /usr/local/lib/perl5/5.10.1 /usr/local/lib/perl5/site_perl/5.10.1/darwin-2level /usr/local/lib/perl5/site_perl/5.10.1 .) at (eval 4) line 2.
# BEGIN failed--compilation aborted at (eval 4) line 2.
Can't locate object method "new" via package "ConsumptionTax::JP" (perhaps you forgot to load "ConsumptionTax::JP"?) at t/consumption_tax.t line 11.
# Looks like you planned 5 tests but ran 1.
# Looks like you failed 1 test of 1 run.
# Looks like your test exited with 255 just after 1.

当然のことながらテストに失敗します。

これから、このテストを満たすプログラムを実装していきます。

package ConsumptionTax::JP;

use strict;
use warnings;

use base qw/Class::Accessor::Fast/;

__PACKAGE__->mk_accessors(qw/ consumption_tax_rate /);

sub tax_include {
    my ($self, $price) = @_;
    return $price * (1 + $self->consumption_tax_rate);
}

1;

実装ができたら、早速テストを走らせます。

$ perl t/consumption_tax.t
1..5
ok 1 - use ConsumptionTax::JP;
ok 2 - ConsumptionTax::JP->can('tax_include')
ok 3 - 期待値と一致
not ok 4 - 期待値と一致
#   Failed test '期待値と一致'
#   at t/consumption_tax.t line 30.
#          got: '134.4'
#     expected: '134'
not ok 5 - 期待値と一致
#   Failed test '期待値と一致'
#   at t/consumption_tax.t line 37.
#          got: '105.525'
#     expected: '105'
# Looks like you failed 2 tests of 5.

おっと、どうやら実装したプログラムは「計算結果に小数点以下の数が出た場合」と「小数点以下が含まれた値が渡された場合」を考慮しない作りになっていたようです。

このように、期待値と一致しない場合には通知してくれます。

早速期待通り動作するように修正します。

return $price * (1 + $self->consumption_tax_rate);

となっているところを、下記のようにします。

return sprintf("%d", $price * (1 + $self->consumption_tax_rate));

修正したので、テストします。

$ perl t/consumption_tax.t
1..5
ok 1 - use ConsumptionTax::JP;
ok 2 - ConsumptionTax::JP->can('tax_include')
ok 3 - 期待値と一致
ok 4 - 期待値と一致
ok 5 - 期待値と一致

今度は期待通りの挙動をしています。

これで、仕様を満たすプログラムが実装できました。

その他のテスト用関数

今回はほぼisしか使いませんでしたが、他にも下記のようなものがよく使われたりします。

関数	何をチェックするか	使い方
ok	真偽値	ok($val, '$val is true');
isnt	文字列が等しいかどうか	is($string, 'string', '$string is not "string"');
is_deeply	arrayやhashの比較	is_deeply($val, { key => 'val'}, '$val is match');
like	正規表現と一致するかどうか	like($val, qr/正規表現/, '$val is match');

他にもいろいろなテスト用関数が提供されています。

詳しく知りたい場合はperldocなどを確認するのがよいです。

テストが増えてきたら

開発しているモジュールの数が増えると、つられてどんどんテストファイルが増えていったりします。

そんなとき個別に

$ perl t/test.t

とかコマンドを打ちまくるのは刺身タンポポの香りがしてきます。

そんなときはproveコマンドを使うのがよいです。

proveコマンドはTest::Harnessについてくるコマンドラインツールです。

Test::Harnessもコアモジュールなので、特にインストールなどは不要です。

使い方は簡単で、

$ prove t/*.t

という風にコマンドを打つと、tディレクトリ以下にあるテストプログラムをまとめて実行してくれます。

おわりに

今回は新規にでっち上げたモジュールのテストを書きましたが、当然既存のモジュールに対するテストを記述することも可能です。

師走の大掃除の際にソースコードを整理することがあると思いますが、その際には是非テストコードを書いてあげてください。

明日はsfujiwaraさんです。楽しみにしています！

追記(done_testingについて)

xaicronさんに「done_testingに触れてほしかったなう」とご希望いただいたので追記します。

done_testingとはTest::Moreの0.87から追加された機能です。

通常テストを書く際には

plan (tests => 5);

という感じにテストの数を指定しなければなりません。

指定しない場合は「no_plan」と書くように言われているドキュメントもありますが、これだと本来通らないはずのテストが通ってしまったりして、テストの意味がなくなってしまいます。

とはいえ開発途上でテストの数がどんどん増えたり、あるいは減ったりすることはよくある話です。

そんなときにはno_planを指定せず、テストコードの最後に

done_testing;

と書いておきましょう。

そうしておくと、明示的にテスト数を指定しなくてもテストが実行でき、かつテストが失敗した場合はその旨表示してくれます。

SEE ALSO

http://d.hatena.ne.jp/tokuhirom/20090706/1246861746

% perldoc CGI

% perldoc perl

perlvar

perlvarはいわゆる巷で言われる「Perlの訳の分からない変数」がリストされています。変数は「variable」というのでperlvarです。下唇を噛んで発音して覚えて下さいね

このマニュアルを使うときは前半の説明とかどうでもいいので、お使いのビューアーの検索機能で探したい変数の名前を一気に探すのが吉です。

あと、このマニュアルにはuse Englishというものと、use Englishが提供する特殊変数の代替版がリストされています（例：$/ → $INPUT_RECORD_SEPARATOR)が、これはさっくり無視しましょう。use Englishはメモリも食う割にはあんまりメリットがないです。経験者は語ります。

ともあれ、特殊変数なんて別に暗記する必要もないので忘れる度にこのマニュアルを見に行ってます。僕が一案よく使う特殊変数は $]と$/ですね。

perlre

これはいわゆる正規表現のマニュアルです。これまた文法をよく忘れるのでよく使います。perlvarと同じくビューアーの検索を使うのが吉ですが、何せ記号だらけなのでvimなどの正規表現を理解する検索システムではエスケープしなくてはいけないので余計に検索しにくいです。

個人的には"Extended Patterns"の項を一番よく使ってます。特に忘れがちなのが"zero-width look-ahead"系と"zero-width look-behind"系です。

$string =~ /(foo(?=bar))/; # fooの後にbarが存在したら、"foo"をマッチ
$string =~ /(foo(?!bar))/; # fooの後にbarが存在しなかったら、"foo"をマッチ
$string =~ /((?<=bar)foo)/; # fooの前にbarが存在したら、"foo"をマッチ
$string =~ /((?<!bar)foo)/; # fooの前にbarが存在しなかったら、"foo"をマッチ

(?!)

はよく使うので覚えているのですが、それ以外はどうしても覚えられない。ちなみにここで検索する場合は上記のように"look-ahead"とか、そういうキーワードをちょっと覚えていると検索しやすいです。

その他正規表現の仕組みついて色々説明してくれているので、Jeffrey Friedl氏の名著「詳説 正規表現」にお金を出したくない人は読んでおくといいかもしれません。

perlopentut

Perlのopen()関数は色々な使い道があるので結構忘れがちです。perlopentut（これ以後もそうですが、チュートリアル→tutorial→tutと覚えてくださいね）ではこのopenの様々な使い方を教えてくれます。

この章は特に検索に使うというより、とにかくopen() の使い方を教えてくれるので、暇な時にでも熟読してみるといいんじゃないでしょうか。open() のリファレンスとしては perldoc -f openのほうがいいかもしれません。

perlpacktut

こちらはPerlのpack() 関数を教えてくれるチュートリアルです。バイナリアンじゃない僕はここに書いてあることがぼんやりとしかわかってませんが、とりあえずこれを読みながらmemcachedのバイナリプロトコルを実装したりしてました。perldoc -f packも、packのテンプレート種別が一気に表示されるので便利です。

perlipc

IPCとはInter-Process Communicationの事で、要はプロセス間通信です。僕はfork()を使ったコードをある一定の周期で書くことが多いのですが、そのたびに子プロセスの回収の仕方を忘れるので毎回ここで見て思い出します。どうしてもwaitpidとかが思い出せないのです。で、いつもこんなコードを書きます：

use strict;
use POSIX qw(WNOHANG);

my %children;
my $to_fork = 10;

local $SIG{CHLD} = sub {
    while ( (my $pid = waitpid(-1, WNOHANG()) > 0 ) ) {
        delete $children{$pid};
    }
};

for my $i (1..10) {
    my $pid = fork();
    if (! defined $pid) {
        die "Failed to fork";
    }

    if ($pid) { # parent
        $children{ $pid }++;
    } else {
        # child
        local %SIG;
        ....
        exit;
    }
}

# なにかしながら%childrenが空になるのを待つ

perlxs, perlapi, perlapio, perlguts, perlclib

PerlのCバインディングであるXSを書くときはこの辺りは必須です。

perlxsはXSの基本、perlclibはCレイヤーでPerlが提供するユーティリティ関数（メモリ確保とか、文字列比較とか）のリスト、perlapiはPerlの関数・マクロ群、perlapioはI/O関連のAPI、perlgutsは内部構造の説明等が載ってます。

正直XSのイントロとしては無理があるので、拙著「モダンPerl入門」を推したいところですが、個人的にはこれらのマニュアルと、Tim Bunce氏のMemcached::libmemcachedのソースコードが大変ためになりました。

以上個人的によく使っているマニュアル群でした。これ以外にも結構たくさんありますので是非どうぞ。ちなみに有志で日本語翻訳を行ってくれているperldocjpプロジェクトがいままで訳してきたそれらのマニュアルはこちらから入手可能です：http://perldoc.jp/docs/perl/。 5.10.x系まで揃ってるので英語が難しいという方はこちらもあわせてどうぞ。

目次

• はじめに
• Chart::Gnuplotの概要
• 準備
• 基本
• 実践
• おわりに

はじめに

Perlでグラフを生成するためのモジュールとしては，グラフィックライブラリGDを利用したGD::Graphとか，GoogleChart APIを利用したGoogle::Chartとかが挙げられますが，最近，ふとしたきっかけで，Chart::Gnuplotなるモジュールの存在を知り，実際に使ってみたところ，なかなかいい感じでした．

今回は，そのChart::Gnuplotについて簡単に紹介してみます．

Chart::Gnuplotの概要

グラフ描画系のツールのひとつにgnuplotというものがあります．

• http://www.gnuplot.info/

スクリーンショットを２点．

• http://farm3.static.flickr.com/2663/4166426208_a8aa809708_o.png
• http://farm3.static.flickr.com/2646/4165669881_f18a216d77_o.png

私の場合，大学在学時のレポートとか卒業研究とかが触れるきっかけでした．TeXで扱うためにEPS形式で出力したものがIllustratorでイジれるとを知って，何やら遊んでいた記憶くらいかありませんが．．．そんなことはどうでもいいですね＞＜

さて，このgnuplot，数式による描画もデータファイル読み込みによる描画もできたり，ラベルとか目盛りとかをはじめ，グラフ描画に関する様々な設定を細かく行えたりと，便利で高機能です．

そんなgnuplotをPerlから操作するためのインタフェイスを提供してくれるのが，このChart::Gnuplotです．

• http://search.cpan.org/~kwmak/Chart-Gnuplot/

出力フォーマット

Chart::Gnuplotは，描画したグラフの出力フォーマットとして，次のものをサポートしています．（出力先の拡張子によって自動で切り替えてくれるみたいですね．）

The supported image formats are:

    bmp  : Microsoft Windows bitmap
    epdf : Encapsulated Portable Document Format
    epi  : Encapsulated PostScript Interchange format
    eps  : Encapsulated PostScript
    gif  : Graphics Interchange Format
    jpg  : Joint Photographic Experts Group JFIF format
    pdf  : Portable Document Format
    png  : Portable Network Graphics
    ppm  : Portable Pixmap Format
    ps   : PostScript file
    psd  : Adobe Photoshop bitmap file
    xpm  : X Windows system pixmap

If the filename has no extension, postscipt will be used.

cite: http://search.cpan.org/~kwmak/Chart-Gnuplot/lib/Chart/Gnuplot.pm#output

これだけサポートしてくれていれば，まず困らないのではないでしょうか．

グラフ描画

gnuplotでは，2次元だけでなく，3次元の描画も行えます．もちろん，Chart::Gnuplotからでも可能です．

しかし，ここでは簡単に2次元描画にしぼって行きたいと思います．（私が試したことがないので．）

準備

前置きが長くなりましたが，まずは準備から．

In order to use this module, gnuplot need to be installed. If image format other than PS, PDF and EPS is required to generate, the convert program of ImageMagick is also needed.

cite: http://search.cpan.org/~kwmak/Chart-Gnuplot/lib/Chart/Gnuplot.pm#DESCRIPTION

ということなので，gnuplotとかImageMagickとかをインストールしておきます．（ImageMagickは，PostScript・PDF・EPS形式以外のときに必要になります．入れておいて損はないかと思います．）

% sudo port install gnuplot
% sudo port install ImageMagick +perl
% sudo cpan -i Chart::Gnuplot

※ プラットフォームによって適宜置き換えてください．

基本

基本的な使い方は，だいたい次のような流れになります．

• 描画用データの準備
• gnuplotオブジェクトの生成・設定
• データセットオブジェクトの生成・設定
• 描画・出力

コードにすると，こんな感じです．

use Chart::Gnuplot;

# データの準備
my $xdata = [...];
my $ydata = [...];

# gnuplotオブジェクトの生成・設定
my $chart = Chart::Gnuplot->new(
  output => $filename,
  %opts_chart,
);

# データセットオブジェクトの生成・設定
my $dataset = Chart::Gnuplot::DataSet->new(
  xdata => $xdata, # arrayref
  ydata => $ydata, # arrayref
  %opts_dataset,
);

# 描画・出力
$chart->plot2d($dataset);

ちなみに，複数のデータセットを一度に描画することもできます．

my $dataset2 = Chart::Gnuplot::DataSet->new(...);

$chart->plot2d($dataset, $dataset2);

実践

もうちょっと実践的にやってみましょう．

データファイル

次のデータは，とあるサーバの負荷平均（ロードアベレージ）を，1日間，約10秒間隔で記録したものの一部です．（uptimeコマンドの出力を利用しています．）

1259593206,0.27,0.18,0.26
1259593216,0.31,0.19,0.27
1259593226,0.26,0.18,0.26
1259593236,0.22,0.17,0.26
1259593246,0.18,0.17,0.26
1259593256,0.16,0.16,0.25
1259593266,0.21,0.17,0.26
1259593276,0.18,0.17,0.25
1259593286,0.15,0.16,0.25
1259593296,0.13,0.15,0.25
...
1259679501,0.69,0.85,0.95
1259679511,1.20,0.96,0.98
1259679521,1.16,0.96,0.98
1259679531,1.38,1.01,0.99
1259679541,1.24,0.99,0.99
1259679551,1.12,0.97,0.98
1259679561,0.95,0.94,0.97
1259679571,0.80,0.91,0.96
1259679581,1.14,0.98,0.98
1259679591,0.97,0.95,0.97

このファイル名を，uptime.datとでもしておきます．

データの読み込み

データファイルにおける，コンマで区切った1列目（時刻）の系列を横軸，2列目（1分間の負荷平均値）の系列を縦軸としたグラフを生成することを考えてみます．

ということで，必要な部分を読み込みます．

my $t = [];  # １列目のデータ系列が入る
my $y = [];  # ２列目のデータ系列が入る

open my $fh, '<', 'uptime.dat'  or  die $!;
while (my $row = <$fh>) {
  #chomp $row;
  my ($time, $load) = split /,/, $row;

  # 時刻データを，00:00:00からの秒数に置き換える
  my ($ss, $mm, $hh) = (localtime $time)[0..2];
  $time = ($hh*60*60 + $mm*60 + $ss);
  $time /= 60*60;  # 1時間を0〜1の範囲に圧縮する

  push @$t, $time;
  push @$y, $load;
}
close $fh;

gnuplotオブジェクトの準備

次にgnuplotオブジェクトを生成します．

＃use Chart::Gnuplot; しているものとします

my $chart = Chart::Gnuplot->new(
  output    => 'uptime.png',
  imagesize => '1.5, 1.0',
  title     => '2009-12-01',
  xrange    => [0, 24],
  yrange    => [0, 3],
  xlabel    => 'time',
  ylabel    => 'load',
  grid => {
    width => 2,
    color => '#666666',
  },
  xtics => {
    along    => 1,
  },
  ytics => {
    along    => .5,
    labelfmt => '%.1f',
  },
  orient => 'landscape',
);

ここでのオプションの概要は次のような感じです．

output

出力先

imagesize

出力の相対的なサイズ

xrange

横軸の値の範囲

yrange

縦軸の値の範囲

xlabel

横軸につけるラベル

ylabel

縦軸につけるラベル

grid

補助線の種類とか色とか

xtics

横軸の刻み

ytics

縦軸の刻み

orient

用紙（？）の方向

gnuplotを使われたことのある方にとっては馴染みのある単語が並んでいますね．

詳細はCPANの同モジュールのページをご覧ください

• http://search.cpan.org/~kwmak/Chart-Gnuplot/lib/Chart/Gnuplot.pm#Chart_Options

データセットオブジェクトの準備

先に準備したデータを基に，データセットオブジェクトを生成します．

my $dataset = Chart::Gnuplot::DataSet->new(
  xdata => $t,
  ydata => $y,
  style => 'impulses',
  color => '#ff0000',
);

ここでのオプションの概要は次のような感じです．

xdata

横軸のデータ

ydata

縦軸のデータ

style

描画の種類

color

描画の色

描画の種類によって指定する項目が異なったりします．詳細は次をご覧ください．

• http://search.cpan.org/~kwmak/Chart-Gnuplot/lib/Chart/Gnuplot.pm#Dataset_Options

描画・出力

あとは，次の1行で出力するだけです．

$chart->plot2d($dataset);

できあがり

すると，次のようなPNG画像ができあがります．

• http://farm3.static.flickr.com/2667/4166298909_c206912f66_o.png

おわりに

以上，Chart::Gnuplotの概要と，同モジュールを使ってグラフを生成する過程をざっと紹介してみました．

それでは，楽しいグラフ描画ライフをおすごしください．

さーて，明日のカジュアルさんは？

冒頭で少し言及したGoogle::Chartモジュールの作者でもあるlestrratさんです．お楽しみに！