Big Sky

HTML::TreeBuilderは便利だけど、データ構造がロジックになってしまうのが難点。

Perlでブックオフの店舗を検索し、結果をハッシュの配列に格納する - As a Futurist...

HTMLを解析する練習です。Perlの配列とかハッシュの扱いも少し分かりました。 以下のブックオフの検索をPerlでやっただけです。

http://blog.riywo.com/2008/03/31/164327

ってことでWeb::Scraperで。

#!/usr/bin/perl -w

use strict;
use warnings;
use URI;
use Web::Scraper;
use YAML;

my $str = shift || '新宿';
my $uri = URI->new( 'http://www.bookoff.co.jp/shop/shop.php' );
$uri->query_form(
    action => 'search',
    station => $str,
    shop_name => $str,
);

warn Dump scraper {
    process '//tr[td]', 'res[]' => scraper {
        process '//td[1]', name => 'TEXT',
        process '//td[2]', time => 'TEXT',
        process '//td[3]', tel => 'TEXT',
        process '//td[4]', place => 'TEXT',
    };
    result qw/res /;
}->scrape( $uri );

Web::Scraper便利。
process書かずに

name => '//td[1]/text()'

とか書けるシンタックスシュガーあったらなぁ...とか思った。

家では貧弱なマシンを使っているので、極力重い処理は避けたいと色んな設定を入れています。その一つにperlのファイルを開いた際に"ftplugin/perl.vim"がINCを調べるのに実行する

perl -e 'print join(q/,/,@INC)'

というコマンドの抑制。ただ単にperlのモジュールパスを調べるいるだけなんですが、ファイルを開くだけでperlを実行されるのも...という方には以下の設定をvimrcに追加すると実行されなくなります。

let g:perlpath="XXX"

このXXXには上記コマンドの実行結果を設定します。
Windows系ならば

perl -e "print join(q/,/,@INC)"

で得られる文字列となります。ActivePerlだとおそらく

let g:perlpath = "c:/perl/site/lib,C:/perl/lib"

と設定すれば良いかと思います。

ま、最近の人はリッチなマシン使ってる人多いから、メリット無いかな。
ちなみにUNIX系でperlのバージョン上げたりするとモジュールパスが変りますので再度この設定をし直す必要があります。ご注意を。

perl版もあったんですね。

Perl App Engine状況報告、Protocol BufferのPerl対応 | エンタープライズ | マイコミジャーナル

Perl App Engineに関連したコードベースにはおもに次の3つがある。

• Perl App Engine
• Perl XS module Sys::Protect
• Protocol Buffers for Perl

http://journal.mycom.co.jp/news/2008/07/29/042/index.html

protobuf-perl - Google Code

Protocol Buffers for Perl.

http://code.google.com/p/protobuf-perl/

さっそく遊んでみました。
まず、protobuf-perlはオリジナルの改造として作られており、スケルトンクラス生成ツール「protoc」をビルドする所からの導入となります。
通常はprotobufディレクトリで

# make -j2 protoc

とすれば出来上がります。ただVisual Studioの場合はlibprotocプロジェクトのソース一覧からperlのgeneratorソースである「perl_generator.cc」が外れてしまっているので、追加してからビルドする必要があります。
出来上がれば、「libprotobuf.dll」と「libprotoc.dll」、「protoc.exe」をパスの通った位置にコピーします。
"main.cc"のソースを見て頂ければ分かりますが、protocol buffersのgeneratorはソースが分離されており、main実行時にプラグインを読み込む様な形で登録されています。

int main(int argc, char* argv[]) {

  google::protobuf::compiler::CommandLineInterface cli;

  // Proto2 C++
  google::protobuf::compiler::cpp::CppGenerator cpp_generator;
  cli.RegisterGenerator("--cpp_out", &cpp_generator,
                        "Generate C++ header and source.");

  // Proto2 Java
  google::protobuf::compiler::java::JavaGenerator java_generator;
  cli.RegisterGenerator("--java_out", &java_generator,
                        "Generate Java source file.");


  // Proto2 Python
  google::protobuf::compiler::python::Generator py_generator;
  cli.RegisterGenerator("--python_out", &py_generator,
                        "Generate Python source file.");


  // Proto2 Perl
  google::protobuf::compiler::perl::Generator perl_generator;
  cli.RegisterGenerator("--perl_out", &perl_generator,
                        "Generate Perl source file.");

  return cli.Run(argc, argv);
}

別の言語でgeneratorを作る場合、"XXX_generator.h"と"XXX_generator.cc"を作り、"main.cc"でincludeとRegisterGeneratorを実行すれば動き出す仕組みになっています。キレイな作りですね。

さて出来上がった"protoc"でperlのラッパクラスを作ります。
先日ご紹介した際に使った"person.proto"を使います。ここで注意しなければならないのが、"--perl_out"オプションを使用する際の引数で指定するファイル名がパッケージ名として使われてしまう点です。
perlパッケージ名称がそれっぽくなる様に以下の様に実行します。

# protoc --perl_out=. Person.proto

UNIX系の方は"person.proto"から"Person.proto"にリネームしてから実行して下さい。Windowsならばそのまま実行出来ます。
出来上がった"ProtoBuf::Person"は以下の様になりました。

## Boilerplate:
# Auto-generated code from the protocol buffer compiler.  DO NOT EDIT!

use strict;
use warnings;
#use 5.6.1;
use Protobuf;
package ProtoBuf::Person;


use constant TRUE => 1;
use constant FALSE => 0;
## Top-level enums:

## Top-level extensions:

## All nested enums:
## Message descriptors:

our $_PERSON = Protobuf::Descriptor->new(
  name => 'Person',
  full_name => 'protocol.Person',
  containing_type => undef,
  fields => [
    Protobuf::FieldDescriptor->new(
      name => 'name', index => 0, number => 1,
      type => 9, cpp_type => 9, label => 2,
      default_value => "",
      message_type => undef, enum_type => undef, containing_type => undef,
      is_extension => FALSE, extension_scope => undef),
    Protobuf::FieldDescriptor->new(
      name => 'age', index => 1, number => 2,
      type => 5, cpp_type => 1, label => 2,
      default_value => 0,
      message_type => undef, enum_type => undef, containing_type => undef,
      is_extension => FALSE, extension_scope => undef),
  ],
  extensions => [
  ],
  nested_types => [],  # TODO(bradfitz): Implement.
  enum_types => [
  ],
  options => Protobuf::MessageOptions->new(
  ),
);

## Imports:

## Fix foreign fields:

## Messages:
Protobuf::Message->GenerateClass(__PACKAGE__ . '::Person', $_PERSON);

## Fix foreign fields in extensions:
## Services:

実装はMooseを使っており、アクセサに対する制御も行っています。
次にサンプルコード

use strict;
use warnings;
no warnings qw(deprecated);
use Protobuf::Decoder;
use ProtoBuf::Person;

my $person = ProtoBuf::Person::Person->new;
$person->set_name('mattn');
$person->set_age(18);

open my $out, '>', 'person_perl.txt';
print $out $person->serialize_to_string();
close $out;

my $other = ProtoBuf::Person::Person->new;
open my $in, '<', 'person_perl.txt';
$other->parse_from_string( do { local $/;<$in> } );
close $in;

printf "name:%s\nage:%d\n", $other->name(), $other->age();

前回と同様にファイルに書き出し、ファイルから読み込んでparse_from_stringで実体化します。結果は前回と同様です。

cppは別として、pythonの場合はpickleが、javaの場合はSerializableがあり、Google Protocol Buffersの使い所が難しい気もしましたが、色々な言語がサポートされてくると言語をまたいだデータ共有という形で使えそうな気がして来ました。特にmemcachedを使ったダイナミックインスタンスエクスポートとか面白いかもしれませんね。
またperl版がMooseと絡んでいる所がとても通ぽくて良いですね。:-)
どうせなら、PerlIOでシリアライズ出来たらな...と思ってしまいましたが、もしかしたら今後サポートされるかもしれませんね。

他にもprotocol buffersはいろんな言語でインプリメンツされているので、皆さんもお好きな言語で遊んでみてはいかがでしょうか。

kuさんが面白い物見つけてくれました。

mixi for iPhoneから発掘されたmixi日記投稿用API « ku

iPhoneからぜんぜん日記を書く手段がなかったらmixiから、mixi for iPhoneという日記を書いたりするiPhoneアプリが公開されました！

新しいアプリに新しいAPI、日記が投稿できるアプリなら日記投稿用のAPIというわけでmixiのあしあとAPI発掘と同じように掘り起こして見つけました。

ほかのAPIと同様、認証はWSSEでatomPubで日記を書くことができるようになっていました。エンドポイントはhttp://mixi.jp/atom/diary/member_id=mixiIDです。

http://ido.nu/kuma/2008/07/30/digging-mixi-for-iphone-application-and-new-api-for-posting-a-diary-with-a-photo/

って事でさっそくPlagger用にPublish::MixiDiary書いてみました。出来立てほやほやなので、あまりテストしていません。codereposに上げているので、良かったらテストしてみて下さい。

これでtwitterの様にmixiを使って、マイミク外される事うけあいですね。

Publish::MixiDiary

ちなみに中ではたけまるさんのAtompubを使っています。

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等でも実装されています(参照)。
皆さんも試してみては如何でしょうか。

vimで自前でYAML読み込むとか面倒くさすぎる。
こう言う時はif_pythonとかif_perlとかを使わせてもらう。運良くvimスクリプトはjsonと相性が良いのでYAMLを読み込み、JSONに変換してvimに戻してあげる。

function! LoadYAML(file)
  perl << EOF
use YAML::Syck;
use JSON::Syck qw(Dump);
eval {
  VIM::DoCommand("let ret = " . Dump(LoadFile("".VIM::Eval('a:file'))));
};
VIM::DoCommand("let v:errmsg = substitute('$@', \"\\n\", '', 'g')") if $@;
EOF
  if !exists('ret')
    throw v:errmsg
  endif
  return ret
endfunction

echo LoadYAML("config.yaml")

戻り値はDictionary形式になります。
読み込めなかった場合はthrowしているのでvim7限定になりますがcatchしてやって下さい。

さて、if_perlですがperl510で動かなくなってました。今日パッチを作成してvim-devに送ったのですが、如何せん自信がありません(Shibuya.xsでvimmerな皆様、どうか私にお力をお貸し下さい)。
パッチは

vim72-perl510-fix.diff

にあります。不具合報告等あればご連絡下さい。

最近TheSchwartが賑わってる様ですね。

TheSchwartzで仕事をあとにまわす - bits and bytes

なければ勝手に作ってくれるのかなと思ってSYNOPSISのコードを実行してみたけどやっぱり自動でできたりはしなそうだったので調べたらCatalyst and TheSchwartz: Reliable JobQueue in a great framework - Voxにschema.sqlを使うといいと書いてありました。このスキーマをmysqlで実行すればTheSchwartzのキューを管理するためのテーブルが出来上がります。

http://labs.gmo.jp/blog/ku/2008/06/theschwartz.html

Twitter / ku: TheSchwartzおもしろかった sqliteで動...

TheSchwartzおもしろかった sqliteで動くようにしたいけどsqliteようのschemeかきかたわかんない

http://twitter.com/ku/statuses/843135311

って事でSQLiteでも動く様に出来ないか調べてみました。
schema.sqlは、MySQL用のスキーマで

CREATE TABLE funcmap (
        funcid         INT UNSIGNED PRIMARY KEY NOT NULL AUTO_INCREMENT,
        funcname       VARCHAR(255) NOT NULL,
        UNIQUE(funcname)
);

CREATE TABLE job (
        jobid           BIGINT UNSIGNED PRIMARY KEY NOT NULL AUTO_INCREMENT,
        funcid          INT UNSIGNED NOT NULL,
        arg             MEDIUMBLOB,
        uniqkey         VARCHAR(255) NULL,
        insert_time     INTEGER UNSIGNED,
        run_after       INTEGER UNSIGNED NOT NULL,
        grabbed_until   INTEGER UNSIGNED NOT NULL,
        priority        SMALLINT UNSIGNED,
        coalesce        VARCHAR(255),
        INDEX (funcid, run_after),
        UNIQUE(funcid, uniqkey),
        INDEX (funcid, coalesce)
);

CREATE TABLE note (
        jobid           BIGINT UNSIGNED NOT NULL,
        notekey         VARCHAR(255),
        PRIMARY KEY (jobid, notekey),
        value           MEDIUMBLOB
);

CREATE TABLE error (
        error_time      INTEGER UNSIGNED NOT NULL,
        jobid           BIGINT UNSIGNED NOT NULL,
        message         VARCHAR(255) NOT NULL,
        funcid          INT UNSIGNED NOT NULL DEFAULT 0,
        INDEX (funcid, error_time),
        INDEX (error_time),
        INDEX (jobid)
);

CREATE TABLE exitstatus (
        jobid           BIGINT UNSIGNED PRIMARY KEY NOT NULL,
        funcid          INT UNSIGNED NOT NULL DEFAULT 0,
        status          SMALLINT UNSIGNED,
        completion_time INTEGER UNSIGNED,
        delete_after    INTEGER UNSIGNED,
        INDEX (funcid),
        INDEX (delete_after)
);

というSQLなので、これをSQLite用に書き換えます。

cl.pocari.org - SQLite で auto-increment なフィールドを作成する方法

つまり，SQLite で auto-increment なフィールドを作りたければ，INTEGER PRIMARY KEY を指定してあげればいいらしい．

http://cl.pocari.org/2006-02-12-1.html

こちらの記事でも書かれている通り、SQLiteではINTEGER PRIMARY KEYを指定すればok。
※ちなみにUNSIGNEDとかNOT NULLとか付けると動かないです。

で書き換えたSQLは以下の通り

CREATE TABLE funcmap (
        funcid         INTEGER PRIMARY KEY,
        funcname       VARCHAR(255) NOT NULL,
        UNIQUE(funcname)
);

CREATE TABLE job (
        jobid           INTEGER PRIMARY KEY,
        funcid          INTEGER NOT NULL,
        arg             MEDIUMBLOB,
        uniqkey         VARCHAR(255) NULL,
        insert_time     INTEGER UNSIGNED,
        run_after       INTEGER UNSIGNED NOT NULL,
        grabbed_until   INTEGER UNSIGNED NOT NULL,
        priority        SMALLINT UNSIGNED,
        coalesce        VARCHAR(255),
        UNIQUE(funcid, uniqkey)
);
CREATE INDEX job_idx_1 ON job (funcid, run_after);
CREATE INDEX job_idx_2 ON job (funcid, coalesce);

CREATE TABLE note (
        jobid           INTEGER NOT NULL,
        notekey         VARCHAR(255),
        value           BLOB
);

CREATE TABLE error (
        error_time      INTEGER UNSIGNED NOT NULL,
        jobid           INTEGER NOT NULL,
        message         VARCHAR(255) NOT NULL,
        funcid          INTEGER NOT NULL DEFAULT 0
);
CREATE INDEX error_idx_1 ON error (funcid, error_time);
CREATE INDEX error_idx_2 ON error (error_time);
CREATE INDEX error_idx_3 ON error (jobid);

CREATE TABLE exitstatus (
        jobid           INTEGER PRIMARY KEY,
        funcid          INTEGER NOT NULL DEFAULT 0,
        status          SMALLINT UNSIGNED,
        completion_time INTEGER UNSIGNED,
        delete_after    INTEGER UNSIGNED
);
CREATE INDEX exitstatus_idx_1 ON exitstatus (funcid);
CREATE INDEX exitstatus_idx_2 ON exitstatus (delete_after);

あとはコレを

# sqlite3 the_schwartz < theschwartz_schema.sql

としてDBファイルを作る。
さてサーバのコードはDSNを"dbi:SQLite:the_schwartz"にするだけ。

#!/usr/bin/env perl
package MyWorker;
use strict;
use utf8;
use warnings;
use base qw( TheSchwartz::Worker );
use Data::Dumper;

binmode STDERR, ":encoding(cp932)" if $^O eq "MSWin32";

sub work {
    my ($class, $job) = @_;
    warn "お仕事ですよ！ @{[ Dumper($job->arg) ]}\n";
    $job->completed();
}

package main;
use strict;
use warnings;
use TheSchwartz;

my $client = TheSchwartz->new(
    databases => [ +{ dsn => 'dbi:SQLite:the_schwartz' } ]
);
$client->can_do('MyWorker');
$client->work();

さらにクライアントのコード

#!/usr/bin/env perl
use strict;
use warnings;
use TheSchwartz;

my $client = TheSchwartz->new(
    databases => [ +{ dsn => 'dbi:SQLite:the_schwartz' } ]
);
$client->insert('MyWorker' => +{ hoge => "fuga" });

実行すると

お仕事ですよ！ $VAR1 = {
          'hoge' => 'fuga'
        };

という風にサーバ側で表示されます。 ちなみに、DBD::SQLiteのバグで

closing dbh with active statement handles at .../Data/ObjectDriver/Driver/DBI.pm line 566.

という表示が出る様ならばココにある"issue-17603.tar.gz"のパッチを当てるといいです。どうやらこのバグ、デグレっぽいですね。

ま、結局SQLiteでやっちゃったら同一マシンだし負荷分散にはならない(UIロックを避けるという意味では有用)んですけどね。