2008/06/27

Recent entries from same category

  1. PerlでWindowsと親和性の高いreadlineが欲しい → あった「Caroline」
  2. Perl をゆるふわと語ろう
  3. cpanfile とは何か、なぜそれを使いたいのか
  4. plackup の --path 引数
  5. Github Notification API が出たので通知を Growl するの書いた。

TheSchwartzも良いのですが、MySQLが必要だったりポーリングのタイムラグがあったりと、要件に合わない場合というのも出て来たりします。こんな時はどうするか、解決策の一つにメッセージバスがあります。
メッセージバスとして一般的に有名なのが、DBusです。Linux等では数多くのアプリケーションが採用しており、GNOMEもBonoboからの移行を表明、KDE4でも採用される様です。ちなみに私が愛用している軽量デスクトップROXは当初に採用しており、ちょっとしたpythonのコードでリッチなアプリケーション間通信が実現出来ています。他にも既に色々なプロジェクトでDBusが使われています。
さて今日はNet::DBusを使い、TheSchwartzと似たような事が出来ないかをWindows上でやってみようかと思います。
まず、DBusのWindows実装であるwinDBusをインストールします。winDBusはこちらで配布されておりバイナリもダウンロード出来ます。
ここでまず、DBusの動作を確認します。winDBusを展開したディレクトリの中のbinフォルダに移動し以下の様にしてデーモンを起動します。 C:¥winDBus¥> dbus-daemon.exe --config-file=C:/winDBus/dbus/bin/session.conf winDBusを"C:¥Programme"に展開された場合には C:¥Programme¥> dbus-daemon.exe --session とするだけでも動作します。winDBusの場合、unixドメインソケットをサポートしていませんので、上記session.confに書かれている <listen>tcp:host=localhost,port=12434</listen>
 の値を環境変数「DBUS_SESSION_BUS_ADDRESS」に設定します。 set DBUS_SESSION_BUS_ADDRESS=tcp:host=localhost,port=12434 その上でdbus-daemon.exeと同じ位置にあるtest_names.exeを実行し Successfully acquired name 'org.freedesktop.DBus.Test'
Successfully acquired name 'org.freedesktop.DBus.Test-2'
Successfully acquired name 'org.freedesktop.DBus.Test_2'
 と表示されれば動作確認は終了です。
次にNet::DBusをインストールします。まずNet::DBusはビルドにpkg-configを使うので`pkg-config --cflags dbus-1`が扱えないVCではビルドに難があります。私の場合はMinGWを使用しました。
まず、winDBusに同梱されていなかったdbus-1.pcを作成します。winDBusをインストールしたディレクトリを指定して prefix=C:/winDBus/dbus
exec_prefix=${prefix}
libdir=${exec_prefix}/lib
includedir=${prefix}/include

Name: D-Bus
Description: D-Bus Protocol Library
Version: 0.90
Libs: -LC:/winDBus/dbus/lib -ldbus-1
Cflags: -IC:/winDBus/dbus/include
 という内容でdbus-1.pcを保存します。次に環境変数PKG_CONFIG_PATHにこのdbus-1.pcを保存したディレクトリを設定し、cpanからインストールします。おそらくこれでインストール出来るかと思いますが、出来なかった方はVCのコンパイラのパスを外し、MinGWのパスを設定して確認して見て下さい。
これでようやくperlからDBusを使える準備が揃いました。
さて、サーバのソース。DBusのセッションからバスを取得し、サービスをエクスポート、ワーカーの役目をするオブジェクトを作成します。ワーカーオブジェクトにはJobStartというメソッドを定義します。
#!/usr/bin/perl

use strict;
use warnings;
use threads;
use YAML;
use Net::DBus;
use Net::DBus::Service;
use Net::DBus::Reactor;

package MyWorker;
use base qw(Net::DBus::Object);
use Net::DBus::Exporter qw(net.kaoriya.mattn.DBusWorker);

sub new {
    my $class = shift;
    my $service = shift;
    my $self = $class->SUPER::new($service, "/MyWorker");
    bless $self, $class;
    
    return $self;
}

dbus_method("JobStart", [["dict", "string", "string"]], [["dict", "string", "int32"]]);
sub JobStart {
    my $self = shift;
    my $job = shift;
    my $thread = threads->new(sub {
        my $job = shift;
        printf "processing job%03d : %s\n", threads->tid, $job->{request};
        sleep 10;
        printf "done job%03d\n", threads->tid;
    }, $job);
    return { "id" => $thread->tid };
}

package main;

my $bus = Net::DBus->session();
my $service = $bus->export_service("net.kaoriya.mattn.DBusWorker");
my $object = MyWorker->new($service);
Net::DBus::Reactor->main->run();
 DBusは非同期通信も提供していますが、リクエストを連続で送った際サーバがビジー状態だとクライアントが側が応答を待ってロックします。
そこで上記ソースではスレッドを起こし、重たい処理をさせる様になっています。スレッド内では"threads->tid"で言わばジョブ番号の役割をするスレッドIDを使ってユニークな処理が出来るかと思います。
さらにクライアントのコード。 #/usr/bin/perl

use strict;
use warnings;

use Net::DBus;
use Net::DBus::Reactor;
use Net::DBus::Callback;
use Net::DBus::Annotation qw(:call);

my $request = shift @ARGV || 'request at '.time();
my $bus = Net::DBus->session();
my $service = $bus->get_service("net.kaoriya.mattn.DBusWorker");
my $object = $service->get_object("/MyWorker");
my $res = $object->JobStart({ request => $request });
printf "job was accepted as job%03d\n", $res->{id};
 DBusセッションからもらったMyWorkerオブジェクトのJobStartメソッドにリクエスト文字列を指定して送信します。
まずクライアントの実行結果は C:¥winDBus¥test¥> perl client.pl
job was accepted as job001
C:¥winDBus¥test¥> perl client.pl
job was accepted as job002
C:¥winDBus¥test¥> perl client.pl
job was accepted as job003
 クライアントではjob001を実行した後、10秒待ってjob002、job003を投入しました。そしてサーバの実行結果 processing job001 : request at 1214560175
done job001
processing job002 : request at 1214560192
processing job003 : request at 1214560195
done job002
done job003
 おぉ！非同期ですね！
DBusでは、引数の構成および戻り値の構成をdbus_methodにて指定でき、文字列(string)や数値(int32等)、配列(array)、タプル(tuple)、構造体(struct)を引き渡したり、戻り値として返したり出来ます。
さらに、Net::DBusに同梱されている"example-client-async.pl"の様に非同期送信結果を受け取り、完了イベントで結果を受け取るという事も出来ます。 #/usr/bin/perl

use warnings;
use strict;

use Net::DBus;
use Net::DBus::Reactor;
use Net::DBus::Callback;
use Net::DBus::Annotation qw(:call);

my $bus = Net::DBus->session();

my $service = $bus->get_service("org.designfu.SampleService");
my $object = $service->get_object("/SomeObject");

print "Doing async call\n";
my $reply = $object->HelloWorld(dbus_call_async, "Hello from example-client.pl!");

my $r = Net::DBus::Reactor->main;

sub all_done {
    my $reply = shift;
    my $list = $reply->get_result;
    print "[", join(", ", map { "'$_'" } @{$list}), "]\n";

    $r->shutdown;
}

print "Setting notify\n";
$reply->set_notify(\&all_done);

sub tick {
    print "Tick-tock\n";
}


print "Adding timer\n";
$r->add_timeout(500, Net::DBus::Callback->new(method => \&tick));

print "Entering main loop\n";
$r->run;
 今回はWebで扱いやすい様に、非同期で結果を待機する処理ではなくサーバ側でスレッドを実行していますが、デスクトップクライアントを作る際にはdbus_call_asyncを使う事になるかと思います。

TheSchwartzも面白いですが、DBusも面白いですね。
perlの他にも、C(GLib)はもちろんpythonやJava等でも実装されています(参照)。
皆さんも試してみては如何でしょうか。
Posted at by