Perlの最近のブログ記事

なんだか寝れずに朝3時に起きてしまったので、書いてみる。

Perl で L10N といえば、Locale::Maketext::Lexicon ですが、間違った *.po ファイルを Gettext で指定すると、これでもかってくらいに探しまくるんですよね。例えば、実際に使いたい strings.po は /doko/soko/strings.poなのに、間違って /soko/strings.poを指定したとします。こんな感じ

    package Hello::I18N::de;
    use base 'Hello::I18N';
    use Locale::Maketext::Lexicon (Gettext => '/soko/strings.po');
    1;

すると、Gettext が SCALAR なので、Locale::Maketext::Lexicon::lexicon_get_() が呼び出されるんですが、ここでのファイルが見つからなかったときの探し方が。。

    my @path = split( '::', $caller );
    push @path, $lang if length $lang;

    $src = (
        grep { -e } map {
            my @subpath = @path[ 0 .. $_ ];
            map { File::Spec->catfile( $_, @subpath, $src ) } @INC;
          } -1 .. $#path
      )[-1]
      unless -e $src;

@INC で map して grep して -e って。$caler は scalar caller で定義されて Locale::Maketext::Lexicon が入ってるんだけど、結局のところ、たとえば手元の環境だと

/usr/lib/perl5/5.8.8/i686-linux/Locale/soko/strings.po
/usr/lib/perl5/5.8.8/Locale/soko/strings.po
/usr/lib/perl5/site_perl/5.8.8/i686-linux/Locale/soko/strings.po
/usr/lib/perl5/site_perl/5.8.8/Locale/soko/strings.po
/usr/lib/perl5/site_perl/5.8.5/Locale/soko/strings.po
/usr/lib/perl5/site_perl/5.8.4/Locale/soko/strings.po
/usr/lib/perl5/site_perl/5.8.3/Locale/soko/strings.po
/usr/lib/perl5/site_perl/5.8.2/Locale/soko/strings.po
/usr/lib/perl5/site_perl/5.8.1/Locale/soko/strings.po
/usr/lib/perl5/site_perl/5.8.0/Locale/soko/strings.po
/usr/lib/perl5/site_perl/Locale/soko/strings.po
/usr/lib/perl5/5.8.8/i686-linux/Locale/Maketext/soko/strings.po
/usr/lib/perl5/5.8.8/Locale/Maketext/soko/strings.po
/usr/lib/perl5/site_perl/5.8.8/i686-linux/Locale/Maketext/soko/strings.po
/usr/lib/perl5/site_perl/5.8.8/Locale/Maketext/soko/strings.po
/usr/lib/perl5/site_perl/5.8.5/Locale/Maketext/soko/strings.po
/usr/lib/perl5/site_perl/5.8.4/Locale/Maketext/soko/strings.po
/usr/lib/perl5/site_perl/5.8.3/Locale/Maketext/soko/strings.po
/usr/lib/perl5/site_perl/5.8.2/Locale/Maketext/soko/strings.po
/usr/lib/perl5/site_perl/5.8.1/Locale/Maketext/soko/strings.po
/usr/lib/perl5/site_perl/5.8.0/Locale/Maketext/soko/strings.po
/usr/lib/perl5/site_perl/Locale/Maketext/soko/strings.po
/usr/lib/perl5/5.8.8/i686-linux/Locale/Maketext/Lexicon/soko/strings.po
/usr/lib/perl5/5.8.8/Locale/Maketext/Lexicon/soko/strings.po
/usr/lib/perl5/site_perl/5.8.8/i686-linux/Locale/Maketext/Lexicon/soko/strings.po
/usr/lib/perl5/site_perl/5.8.8/Locale/Maketext/Lexicon/soko/strings.po
/usr/lib/perl5/site_perl/5.8.5/Locale/Maketext/Lexicon/soko/strings.po
/usr/lib/perl5/site_perl/5.8.4/Locale/Maketext/Lexicon/soko/strings.po
/usr/lib/perl5/site_perl/5.8.3/Locale/Maketext/Lexicon/soko/strings.po
/usr/lib/perl5/site_perl/5.8.2/Locale/Maketext/Lexicon/soko/strings.po
/usr/lib/perl5/site_perl/5.8.1/Locale/Maketext/Lexicon/soko/strings.po
/usr/lib/perl5/site_perl/5.8.0/Locale/Maketext/Lexicon/soko/strings.po
/usr/lib/perl5/site_perl/Locale/Maketext/Lexicon/soko/strings.po

これ全部 stat(2) して、「ぜぇぜぇ、がむばって探したけど無かったよ。じゃ、死にます」みたいな。いやぁ、そこまでがんばらなくていんだけどなぁ。そもそも scalar caller で $caller 定義しているのは本当にやりたいことなんだろうかとか思ったら 「scalar caller(1) でしょ？」ってのが RT に2年前に登録されてるな。まぁ、先にファイルが存在するのをチェックしないお前が悪いってことか。

まとめ: Locale-Maketext-Lexicon で Gettext でファイルを指定するまえに -e なりでそのファイルの存在を確かめましょう。DProfもいいけど strace を使うことで簡単に見つかるパフォーマンス改善ポイントもありますよという話でした。

あるウェブサイトから rel="me" というリンクを抽出して ActionStreams plugin の Other Profile に追加するスクリプト作った。ちょっといじれば tako3.com や fooo.name の情報から追加するものも作れるかと思います。

#!/usr/bin/perl -w

use strict;

use lib 'lib', '../../lib';
use MT::Bootstrap;
use MT;
use Web::Scraper;
use URI;
use Getopt::Long;

my ($uri, $author_id);

GetOptions(
    '--uri=s' => \$uri,
    '--author-id=s' => \$author_id,
);

die unless ($uri and $author_id);

package MT;

my %param;
sub param {
    my $app = shift;
    my $p = shift;
    @_ ? $param{$p} = shift : $param{$p};
}
sub validate_magic { 1 }
my $user;
sub user {
    unless($user) {
        $user = MT->model('author')->load($author_id);
    }
    return $user;
}
sub uri {}
sub redirect {}

package main;

my $app = MT->new() or die MT->errstr;
my $scr = scraper {
    process 'a[rel=~"me"]',
        'profiles[]' => scraper {
            process 'a',   url => '@href';
        };
    result 'profiles';
};
my $profiles = $scr->scrape(URI->new($uri));

my $reg = $app->registry('profile_services');

my %services = map { $reg->{$_}->{url} => $_ } 
               grep {! $reg->{$_}->{ident_exact}} keys %$reg;

foreach my $profile (@$profiles) {
    my ($ident, $type) = find_ident($profile->{url});
    if ($type) {
        add_profile($ident, $type);
    }
}

sub find_ident {
    my ($url) = @_;
    my $ident;
    my $type;
    foreach my $url_pattern (keys %services) {
        $ident = _find_ident($url_pattern, $url);
        last if $ident and $type = $services{$url_pattern};
    }
    return $ident, $type;
}

sub _find_ident {
    my ($url_pattern, $url) = @_;
    $url =~ s{ \A http:// }{}xms;
    $url =~ s{ / \z }{}xms;
    my ($pre_ident, $post_ident) = split /\%s/, $url_pattern;
    $pre_ident =~ s{ \A http:// }{}xms;
    $post_ident =~ s{ / \z }{}xms;
    if ($url =~ m{ \A (?:http://)? \Q$pre_ident\E (.*?) \Q$post_ident\E /? \z }xms) {
        return $1;
    }
    ## Grr.
    $url =~ s{ \A www. }{}xms;
    if ($url =~ m{ \A (?:http://)? \Q$pre_ident\E (.*?) \Q$post_ident\E /? \z }xms) {
        return $1;
    }
    return;
}

sub add_profile {
    my ($ident, $type) = @_;
    my $app = MT->instance;
    $app->param('author_id', $author_id);
    $app->param('profile_type', $type);
    $app->param('profile_id', $ident);

    my @streams =  keys %{ $app->registry('action_streams', $type) || {} };
    foreach my $stream (@streams) {
        my $param = join q{_}, 'stream', $type, $stream;   
        $app->param($param, 1);
    }
    use lib 'plugins/ActionStreams/lib';
    use ActionStreams::Plugin;
    use ActionStreams::Init;
    my $ret = ActionStreams::Plugin::add_other_profile($app);
}

perl の Error.pm ってまだメジャーじゃないのかな。 Perlにおけるtry catch

Perlにおいてエラーなんかをトラップするための方法として、evalがあります。

http://perldoc.perl.org/functions/eval.html

で、まず一つ目としてこのevalはあくまで「関数」であって、構文ではありません。具体的にいうならば、

a = 1 / 0;

というものに対して、try catchをするのであれば、Javaならばこうすればいいわけです。

try{
a = 1 / 0;
}catch(Exception e){

}

perl についてくるモジュール Error.pm を使うとこんな感じで書けます。最後に ; が必要なのは一緒で、忘れがちなのも一緒ですがｗ。

#!/usr/bin/perl

use strict;
use warnings;
use Error qw(:try);

my $division_by = shift || 0;
my $a;

try {
    $a = 1/ $division_by;
    return $a;
}
catch Error with {
    my $e = shift;
    warn "XXX: " . $e->text;
};

catch したときの $e は Error::Simple オブジェクトです。

perl6だとどうなんだろう？ CATCH が try の中にあるとかいう話も聞いたことがあるけど。。

try {
    &do_something;
    CATCH {
        &error_handling;
    }
}

来日してる US の TypePad エンジニア Garth と話をしているときにでてきた正規表現の話。

$char =~ m/\p{Han}|\p{Hiragana}|\p{Katakana}/; #NG
$char =~ m/[\p{Han}\p{Hiragana}\p{Katakana}]/; #OK

return if $char =~ m/abc|def|ghi/; #NG
return if ($char =~ m/abc/ or $char =~ m/def/ or $char =~ m/ghi/); #OK

"|"(パイプ)を使った正規表現はめちゃくちゃ遅いから使わないように、ということです。確かにベンチマークを取ると32倍速いです。

#!/usr/local/bin/perl
use strict;
use warnings;

use Benchmark;

my $text = ';lskjdf;klvckxv;zijxcv;oa;vlkaefiuqewizlkvnzlxkcnv'
             . '.z,xmc v/z.x,cmv.z,xnvlafda isjdnfl aksjdfauerfaie'
             . 'jnlfakjdsn;akj;v akjdfvoaijdhfvoiaheriufahpsdiufhaeuhr'
             . ' iuahriufhairuhfapsidfalksjfhaiuphrofiankfjas;dofha[s9'
             . 'hfskjdf;ase;f,sedhfaiuwhefs,dnvflk dfis fapoisf fqjr';

my $count = 500_000;

timethese($count, {
   '00_pipe' => sub { $text =~ m/abc|def|ghi/ },
   '01_nopipe' => sub { $text =~ m/abc/ or $text =~ m/def/ or $text =~ m/ghi/ },
});

__END__
$ perl regex.pl
Benchmark: timing 500000 iterations of 00_pipe, 01_nopipe...
   00_pipe: 33 wallclock secs (32.48 usr +  0.01 sys = 32.49 CPU) @ 15389.35/s (n=500000)
 01_nopipe:  1 wallclock secs ( 1.73 usr +  0.00 sys =  1.73 CPU) @ 289017.34/s (n=500000)

ひょんなことから perldoc perlvar とか perldoc -m English をつらつらと眺めてみました。 punctuation variables は「定義済み変数」って訳されているようです。

$@

EVAL_ERROR

$|

OUTPUT_AUTOFLUSH

$/

INPUT_RECORD_SEPARATOR

$!

OS_ERROR

$$

PROCESS_ID

$_

ARG

このへんは良く使いますね。最近知って便利かなぁと思ったのは以下のようなもの。

$.

INPUT_LINE_NUMBER

perl -ne 'printf "%05d: %s", $., $_;' hoge.pl とかで cat -n の代わりとかできますね。

$,

OUTPUT_FIELD_SEPARATOR

なんか簡単な print debug したいときとか $, = "\n"; print @data; とかやると、@data の中身が改行で区切られて出力されます。ま join "\n", @data でいんだけどさ。

まとめ

perl のスクリプトを読んで見慣れない $" 等の定義済み変数に出会ったら perldoc perlvar で内容を確かめましょう。

    use Acme::Hoge;

    print "foo bar baz foobar\n";
    # hoge fuga piyo hogefuga

    print "sidebar\n";
    # sidebar
    # (not be rewritten)

http://search.cpan.org/~mahito/Acme-Hoge/ fuga や piyo より gaga を使うことが多いです。

Output::Rewrite の作者の人がデモ用に作成したようです。 ex の下においておけばいいのに Acme::* を他のモジュールのデモで使うと CPAN ウォッチャーの目に留まりますね。

IO::All of it to Graham and Damian!

version: 0.34
date:    Mon May  8 01:03:12 PDT 2006
changes:
- Remove dependency on Spiffy.pm
- Apply patches and fix bugs from rt
- rt tickets - 11552 12048 14184 12966 13879 17105 7448 11463 7410 7337 7527
  18465

IO::All が Spiffy に別れを告げたようです。 とはいえ XXX は必要です。

追記
XXX の依存性は実際には無かったみたい。 0.35 で修正されました。 diff

YAPC::Asia 2006 Tokyo が無事終了しました。

「楽しいことに最適化」「駱駝は楽だ」とかそういったフレーズが頭から離れません。 Larry, Damian, Audery といった perl コミュニティのコアにいる人々は 本当にそれを楽しんでいました。 彼らは未来を感じさせてくれるし、現状の問題や亜流に関して寛容。

いつも Shibuya.pm とかで感じるのは 宮川さん が楽しんで何か面白いことやっているから 自然と人が集まるという世界の面白さ。 それが YAPC::Asia によって世界の Perl コミュニティ規模で共感できたのが 個人的に一番嬉しかった。一番興奮したことでした。

参加していた方々も同じように興奮し、満足していたという様子は 最後 Wrap Up 後の長い拍手、片付けシーンの迅速さにに表れたと思います。 誰にでも出来ることはあるし、何か貢献することでコミュニティに入っていくことができる。 みんな、家に帰って何か作ってみようとか思ったのではないでしょうか？

私自身、スタッフの一員としてネットワークと格闘しておりましたが、 小展示ホールのネットワークで不具合があった点をこの場でお詫びします。 民生品とわたしのような素人ではなかなかしっかりとしたものを作れませんでした。 次回はもう少しがんばります。では、また次回 YAPC::Asia 2007 で！

今回のSF出張の準備として電子辞書を買いましたが、 PCで作業中に英語で分からない単語があると アルクの英辞郎 に問い合わせることも多いです。

ふと、どんな単語を問い合わせているのかなぁと作ってみたのが以下のスクリプト

Firefox はプロフィールフォルダ以下にある history.dat というファイルにブラウザの表示履歴データ を保存しています。 保存しているデータは Mork とかいう変態フォーマット。しかし CPAN にはすでに File::Mork という モジュールが存在していて、そいつにデータ解析を任せることが出来ます。 後は取得した File::Mork::Entry を料理するだけです。

YAPC::Asia 2006 Tokyo (Japanese): スピーカーとスポンサーが決定！

YAPC::Asia 2006 Tokyo のスピーカー・スポンサーを発表されました。 豪華なスピーカーです。先走って興奮してます。

せきむらまさよし も Lightning Talk で話す予定。 Perl Debugger の簡単な紹介をしたいなぁと思っております。