Text::MicroTemplate::DataSection
__DATA__ に
__DATA__
@@ index.mt
<html>
<body>Hello</body>
</html>
@@ bar.mt
? if ($true) {
Foo
? }
こう言うのが書いてあるとき、Data::Section::Simple を使うと
get_data_section('index.mt');
とすることで該当セクションだけのデータを簡単に取得することができます。 なので普通の Text::MicroTemplate と組み合わせても
render_mt(get_data_section('index.mt'));
って感じで使えてそんなに苦じゃないわけですが、どうせなら中で include とか extends とかで他のセクションのデータとも連携できるようにしたら便利だなーと思い3分クッキングして Text::MicroTemplate::DataSection と言うのを書いてみました。
使い方は簡単、
use Text::MicroTemplate::DataSection 'render_mt';
とすると Text::MicroTemplate::File ベース、
use Text::MicroTemplate::DataSectionEx 'render_mt';
とすると Text::MicroTemplate::Extended ベースの機能が使えるようになります。
あとは render_mt('index.mt') などとすれば __DATA__ からテンプレート出力が行えます。基本ベースクラスのすべての機能がつかえますので、Exを使っている場合は、
? extends 'base';
? block content => sub {
Hello!
? }
とか
?= include 'hoge'
とかもそのまま __DATA__ のなかのテンプレートで使用することができます。Enjoy!
PerlエンジニアのためのObjective-C Blocks入門
OS X 10.6 以降の xcode では Objective-C に Blocks というシンタックスが追加されている。
Perl でいうところの無名関数（コードブロック）を作ることができる機能で、Perlでいうところの
my $f = sub { ... };
$f->();
は
void (^f)() = ^{ ... };
f();
のように書ける。書式がきもいのはObjective-Cの定めなのであきらめましょう。 より詳しい書式については上記ドキュメントを見ると良い。
しかしデフォルトではPerlのコードブロックとはレキシカル変数の扱いが異なる。
my $i = 0;
my $f = sub { return $i + 1 };
$i++;
$f->(); # 2 を返す
perlではこのようにレキシカル変数はコードブロック内と共有されるが、Objective-Cの場合は
int i = 0;
int (^f)() = ^{ return i + 1; };
i++;
f(); // 1 を返す
このようになる。これはブロックを作成するときのレキシカル変数がコピーされるからである。 Perlとおなじような挙動を望む場合は __block ストレージタイプを指定すればいいようだ。
__block int i = 0;
int (^f)() = ^{ return i + 1; };
i++;
f(); // 2
ここまでわかればObjective-CでBlockの再帰を書くことができる。
__block void (^f)();
f = ^{ f(); };
f();
これは以下とおなじ、
my $f;
$f = sub { $f->() };
$f->();
というようにPerlエンジニアにとっては割と直感的なコードブロックが使えるようになっております。 書式がきもいことをのぞけばいい感じです。
次回は「PerlエンジニアのためのGrand Central Dispatch」の予定です。
追記＠2010-05-11T19:12:48+09:00
はてなブックマーク - PerlエンジニアのためのObjetive-C Blocks - unknownplace.org
lyokato 「Objective-Cの仕様というよりは、Blocks拡張に対応したCコンパイラの仕様かな」
ってことでやってみたら
#include <stdio.h>
int main(int argc, char** argv) {
void (^f)() = ^{ printf("Hello Blocks!\n"); };
f();
return 0;
}
// $ gcc foo.c
// $ ./a.out
でも行けました。gcc の拡張なんですね。あざっす！
qpsmtpd を Server::Starter 化するなど
Perl 製 SMTP サーバーとして qpsmtpd というものがあり、僕もいろいろなところで利用している。主な用途としてはメール連動の Web アプリケーションのメール機能の部分。実際のメール配送などでは使用してない。
フロントに qpsmtpd を置き、アプリで制御する宛先の場合のみ qpsmtpd からジョブキューに流したりする。 それ以外の通常のメールは queue/postfix プラグインなどを使用して裏側の postfix にまかせちゃう。というような使い方をしている。
qpsmtpd 自体は apache.org や perl.org の SMTP として採用されており、パフォーマンスに関しては問題ないのだが、プラグインを書き換えたり設定を変更したりした場合に再起動が必要になるところが、フロントに立てるサーバーとしては不安な部分であった。
なので前々から Server::Starter 対応はしたいとおもっていたが安定動作している既存のサーバーで作業する機会も特になく放置していた。
そしてこのたびめでたく新しく qpsmtpd を設置することになったためいっちょやったるか、となった次第である。
この辺で作業：
http://github.com/typester/qpsmtpd/commits/topic/server_starter
使い方は：
# start_server --port=25 --port=127.0.0.1:20025 -- ./qpsmtpd-async-server-starter
このような感じで、SMTP用のポートと、qpsmtpd 制御用の contig ポートを同時に渡して起動する。その後 Server::Starter の superdaemon にたいし HUP シグナルを送ると graceful restart できる。
古い worker プロセスでは最大 $TIMEOUT 秒（デフォルト60）だけ既存の接続を終了まで待つ、graceful shutdown 機能も併せて実装したので完全にダウンタイムをなくせているはず。
とりあえずあまりテストしきれてないけどドッグフードを食べてがんばろうと思います。
yokohama.pm tech talk #5
OpenSocial なモバイルアプリを書く場合、アプリ単体でテストできるようにしてくれる Moxy の OpenSocial プラグインの話と、外部 API 呼び出しを専用に行う非同期なプロクシサーバーの話をしました。
資料はこちら:
前者に関しては、個人的には OpenSocial モバイルアプリ開発には必須なツールなので良い感じにしていきたいところ。 ＆してくれるひと募集。
後者のプロクシサーバーは「あんまり頭よくない」だけれども、現在のウェブアプリケーションの構成で、API呼び出しの待ち時間をうまく使おうとするときにはこうなるのかなぁと思った。同じようなことをしているところもあるらしい！
個人的にはそれ〜でできるよ！ってのがないかなーと思っていたのだけど、ないっぽいのかなー。
nginx でおしいところまではできるので、モジュール書いたら出来るのか調べてみようと思う。
local::lib を切り替える
レガシーなアプリをメンテするのにレガシーな Perl モジュールが必要になることがあり、そのために古いアプリ用には専用の local::lib ディレクトリを切っているわけですが、普段から日常的に local::lib を使用しているため shell が上がったタイミングではデフォルトの local::lib 環境変数がセットされていて切り替えが非常に面倒だった。
これまではそれほど頻繁に使用しなかったので放置していたのだが、ここのところ頻繁に必要になるためいい加減うざくなってきて簡単に local::lib を切り替えられるよう設定をしてみた。
zsh に次のような関数をつくり、それで local::lib を切り替えるようにする。
function locallib () {
INSTALL_BASE=$1
if [ -d $INSTALL_BASE ]; then
eval $(~/bin/use-locallib $INSTALL_BASE)
fi
}
これは
$ locallib ~/perl5
などのように INSTALL_BASE を指定して使う。指定されたパスが存在したら use-locallib というコマンドを使用して環境変数を切り替えるという内容。
この use-locallib コマンドは以下のようなソースになっていて、古い local::lib の環境変数をクリアするとともに、新しい local::lib の環境変数を print するというものになっている。
#!/usr/bin/env perl
use strict;
use warnings;
use Pod::Usage;
use Config;
use File::Spec;
my $install_base = $ARGV[0]
or pod2usage(-1);
$install_base = File::Spec->rel2abs($install_base);
my $path = $ENV{PATH};
my $perl5lib = $ENV{PERL5LIB};
push @INC, File::Spec->catdir($install_base, 'lib', 'perl5');
require local::lib;
my %env = local::lib->build_environment_vars_for($install_base, 1);
# remove $PERL5LIB set by old local::lib if it exists.
if (my $old_base = $ENV{PERL_MM_OPT}) {
my %mmopt;
for my $opt (split /:+/, $old_base) {
my ($k, $v) = split /=/, $opt;
$mmopt{$k} = $v;
}
if (my $old_installbase = $mmopt{INSTALL_BASE}) {
if ($old_installbase eq $install_base) {
# do nothing if install_base is equal to old one
exit;
}
my @old_perl5lib = (
File::Spec->catdir($old_installbase, 'lib', 'perl5'),
File::Spec->catdir($old_installbase, 'lib', 'perl5', $Config{archname}),
);
$env{PERL5LIB} = do {
my @env;
ENV: for my $e (grep { $_ } split $Config{path_sep}, $env{PERL5LIB}) {
for my $old (@old_perl5lib) {
next ENV if $old eq $e;
}
push @env, $e;
}
join $Config{path_sep}, @env;
};
my $old_path = File::Spec->catdir($old_installbase, 'bin');
$env{PATH} = do {
my @p;
for my $p (grep {$_} split $Config{path_sep}, $env{PATH}) {
next if $p eq $old_path;
push @p, $p;
}
join $Config{path_sep}, @p;
};
}
}
while (my ($k, $v) = each %env) {
print qq[export $k="$v"\n];
}
=head1 NAME
use-locallib - set/switch local::lib environment
=head1 SYNOPSIS
use-locallib (MODULE INSTALL BASE)
これで local::lib を簡単に切り替えられるようになるけれど、複数の local::lib 環境を同時に使用しているとどのシェルがどの local::lib を使用しているかわからなくなってしまう。
そのためシェルのプロンプトに INSTALL_BASE を表示されるようにしてしのいだ。
これは単純に以下のような PERL_MM_OPT の INSTALL_BASE をプリントするスクリプトを PROMPT 設定から読んでいるだけである。
#!/usr/bin/env perl
use strict;
use warnings;
my %mm_opt;
for my $opt (split /:+/, $ENV{PERL_MM_OPT} || '') {
my ($k, $v) = split /=/, $opt;
$mm_opt{$k} = $v;
}
my $install_base = $mm_opt{INSTALL_BASE};
if ($ENV{HOME}) {
$install_base =~ s/^$ENV{HOME}/~/;
}
print $install_base || 'none';
Snow Leopard の Perl とアーキテクチャ
Snow Leopard には二つの Perl がインストールされている
- /usr/bin/perl5.10.0
- /usr/bin/perl5.8.9
デフォルトの /usr/bin/perl は 5.10.0 のほう。それぞれユニバーサルバイナリになっていて、
$ file /usr/bin/perl5.10.0
/usr/bin/perl5.10.0: Mach-O universal binary with 3 architectures
/usr/bin/perl5.10.0 (for architecture x86_64): Mach-O 64-bit executable x86_64
/usr/bin/perl5.10.0 (for architecture i386): Mach-O executable i386
/usr/bin/perl5.10.0 (for architecture ppc7400): Mach-O executable ppc
$ file /usr/bin/perl5.8.9
/usr/bin/perl5.8.9: Mach-O universal binary with 2 architectures
/usr/bin/perl5.8.9 (for architecture i386): Mach-O executable i386
/usr/bin/perl5.8.9 (for architecture ppc7400): Mach-O executable ppc
という感じで、5.10 は 64bit 版があるが、5.8 にはない。
で、普通に perl を実行すると perl5.10.0 は x86_64 で実行され、perl5.8.9 は i386 で実行される。
このアーキテクチャの差が結構くせ者で Snow Leopard 上で普通にライブラリなどを make すると x86_64 だけでビルドされてしまうため、そのようにして作ったライブラリはそのままでは perl5.8.9 からは使えないということになる。
デフォルトの 5.10.0 だけ使っている分にはなにも問題はないのだが、残念なことにこの 5.10.0 というのはいろいろな問題があり、開発に使用することはおすすめできない状況。(せめて 5.10.1 にしてくれればいいのに)
したがって無用なトラブルを避けるためにも 5.8.9 の方を使用するか、自前でビルドした perl を使用するのが良い。
またこのように x86_64、i386 両方のアーキテクチャの実行ファイルがあり得る Snow Leopard に対して自分でライブラリをインストールする場合それらもユニバーサルバイナリにしておくと良い。
念のため追記＠2010-01-08T15:19:23+09:00: もちろんこれは 64bit 対応の CPU の場合の話。そうでない場合はどちらも i386 で実行されるのでこの問題は起こらない。
A simple chat server in AnyEvent
Node.js でつくってるやつ をみて同じくらいで書けそうだなと思ったので試しに AnyEvent で書き直してみた。
#!/usr/bin/perl
use strict;
use warnings;
use AnyEvent::Socket;
use AnyEvent::Handle;
my @clients;
tcp_server undef, 7000, sub {
my ($fh) = @_ or die $!;
my $h = AnyEvent::Handle->new( fh => $fh );
my $leave = sub {
my $client = delete $clients[ fileno($fh) ];
for my $c (grep { defined } @clients) {
$c->{handle}->push_write("$client->{name} has left.\n");
}
};
$h->on_read(sub {
shift->push_read( line => sub {
my ($h, $line) = @_;
my $client = $clients[ fileno($fh) ];
unless (defined $client->{name}) {
if ($line =~ /(\S+)/) {
$client->{name} = $1;
$h->push_write("===========\n");
for my $client (grep { defined } @clients) {
next if $client->{handle} eq $h;
$client->{handle}
->push_write( "$client->{name} has joined.\n" );
}
}
return;
}
my ($command) = $line =~ m!^/(.+)!;
if ($command) {
if ($command eq 'users') {
$h->push_write("- $_->{name}\n") for grep { defined } @clients;
}
elsif ($command eq 'quit') {
$leave->();
}
return;
}
for my $c (grep { defined } @clients) {
next if $c->{handle} eq $h;
$c->{handle}->push_write( "$client->{name}: $line\n" );
}
});
});
$h->on_error(sub {
my ($h, $fatal, $msg) = @_;
$leave->();
$h->destroy;
});
$clients[ fileno($fh) ] = {
name => undef,
handle => $h,
};
$h->push_write("Welcome, enter your username:\n");
};
AE::cv->wait;
行数的にはほぼ同じくらい。
追記＠2009-12-08T10:36:37+09:00： left なメッセージがおかしかったので直した。
AnyEventでirssiプラグインを書く
AnyEvent はその名の通りさまざまなイベントインタフェースに対応していて、その中に irssi が使用している Glib も含まれているため、irssiのプラグインの中で普通に AnyEvent を使用することができます。
キーワード反応を im.kayac.com で自分の IM に通知する higlith2im.pl プラグインを AnyEvent を使用するように書き換えたのが以下です。
use strict;
use warnings;
use Glib;
use Irssi;
use AnyEvent::HTTP;
use HTTP::Request::Common;
our $VERSION = '0.1';
our %IRSSI = (
name => 'hilight2im',
description => 'notify hilight message to IM via im.kayac.com api',
authors => 'Daisuke Murase',
);
sub sig_printtext {
my ($dest, $text, $stripped) = @_;
if ( $dest->{level} & MSGLEVEL_HILIGHT ) {
my $user = Irssi::settings_get_str('im_kayac_com_username') or return;
my $msg = sprintf('[irssi] %s', $stripped);
my $req = POST "http://im.kayac.com/api/post/$user", [ message => $msg ];
my %headers = map { $_ => $req->header($_), } $req->headers->header_field_names;
my $r;
$r = http_post $req->uri, $req->content, headers => \%headers, sub { undef $r };
}
}
Irssi::signal_add('print text' => \&sig_printtext);
Irssi::settings_add_str('im_kayac_com', 'im_kayac_com_username', '');
fork する必要がなくなってシンプルですね！
...とおもいきや現状の AnyEvent::HTTP はなんと HTTP::Request オブジェクトからのリクエスト送信に対応していないため、自分ですべてのリクエストを組み立てる必要があるようです。これは不便。。
ですが、irssi の中で普通に AnyEvent を使うことができるのはなかなか便利です。お試しあれ！
AnyEvent 版は github にあげた。
AnyEventの良いところを3行で
教えて！と言われたのでそのとき答えた物をここにも記す。
- POE みたいにきもくない
- Danga::Socket とかだと自分で実装しないといけないread queueとかそういうのも面倒見てくれる便利モジュールがある＞AnyEvent::Handle
- ドキュメントがアツイ
最後のは主に AnyEvent::Intro のことを言ってますが、これ一通り読めばとりあえず AnyEvent 使えるようになるっていうくらい完璧な内容となっています。
AnyEventとは何かからはじまり、非同期プログラミングの説明からAnyEventを使用したシンプルな例が続き、AnyEvent::Socket や AnyEvent::Handle を使用するのを順々に詳しく説明してくれています。 どうして AnyEvent::Handle みたいな物を使うといいのかというところまで書かれているので、非同期プログラミングやネットワークプログラミングにあまり詳しくない人でも読めるのではないでしょうか。
AnyEvent で $poe_kernel->alias_set 的なことをする方法
最近 AnyEvent にはまっています。おもしろい！
AnyEvent と同じ非同期プログラミングフレームワークであるところの POE では
$kernel->alias_set('hoge');
などとしておくと
$kernel->post( hoge => 'state' );
みたいな感じでどこからでもそのコンポーネントを呼び出すことができました。 しかし AnyEvent ではそう言った機能がないため以下のように Object::Container を使って解決することにしました。
呼び出される側：
use AnyEvent;
use Object::Container 'event';
my $cv = AnyEvent->condvar;
$cv->cb(sub {
my (@args) = $cv->recv;
# ここになんか処理
});
event->register( foo => sub { $cv } );
呼び出す側：
use AnyEvent;
use Object::Container 'event';
event('foo')->send(@args);
Condvarをグローバルなシングルトンコンテナに入れ、それを使って相互にやりとりをするという感じですね。
Object::Container は export する機能がなかったのですが、毎回 Object::Container->get(...) などとかくのがだるかったので import に引数渡すとその名前でコンテナを export する機能をつけました。(0.2以降)
同等のことはいろいろな方法があると思いますが、これが一応今の所の僕の解となってます。参考までに！