楽天広場 Trackback Auto-Discovery

迷惑トラックバック対策：トラックバック…

こんにちは、楽天広場です。

迷惑トラックバック対策として、トラックバックURLの暗号化を行いました。

#!/usr/local/bin/perl
use strict;
use HTML::Entities;
use HTML::TokeParser;
use LWP::Simple;

my $url = 'http://plaza.rakuten.co.jp/hirobastaff/diary/200605290000/';
print rakuten_hiroba_trackback_auto_discovery($url), "\n";

sub rakuten_hiroba_trackback_auto_discovery {
    my $url = shift;
    my $content = get($url) or die "can't fetch $url";
    my $p = HTML::TokeParser->new(\$content);
    my $tb_url;
    while (my $token = $p->get_tag('span')) {
        if ($token->[1]->{class} eq 'jscrypt') {
            my $crypted = decode_entities($token->[1]->{title});
            $tb_url = join('', map { chr(ord($_) ^ 0x4) } split(//, $crypted));
            last;
        }
    }
    return $tb_url;
}

弾さんの CPAN module

前のエントリで触れた、メソッドを定義しているクラスを探すやつですが、弾さんが CPAN にうｐした模様。

とりあえず、インスコしてみようと思ったら、CPAN モジュール経由でインスコできない。
ExtUtils::MakeMaker とかも最新だし、おかしいな…と。

どのクラスで定義されたメソッドなのか

Perl のはなし。

弊社のあるエンジニアが、とあるクラスを継承している他のクラスで呼出可能なとあるメソッドについて、そのメソッドがそのクラス内に定義されていないので、んじゃどこで定義されてるのか？というのを調べるのに時間がかかってた模様。

そんなの @ISA 配列を再帰的に見て、シンボルテーブル + UNVERSAL::isa() の組み合わせで発見出来るだろうなーと思ったので、簡単なテストを書いたら、アッサリ発見出来た。

こういうモジュール欲しい！という人も多いんじゃないかと思ったので、どうせなら CPAN にうｐしようかなと思いつつ、reinvent the 車輪なんじゃないかな？とかも思いはじめ、某 CPAN Author だらけの IRC チャンネルで識者の意見を賜ってみた。

「このモジュールで出来るよ！」

という話がなかったので、んじゃ、ちゃんとしたのを作って contribute だ！
と思っていた矢先に、MATSUNO Tokuhiro さんから、継承関係にあるなら @ISA でいいけど、そうじゃない場合はだめじゃない？という鋭いご指摘が。

package Foo;

use strict;

sub import {
    $pkg = caller;
    no strict 'refs';
    *{"$pkg\::foo"} = \&foo;
}

sub foo {
    # ... do something
}

1;

package Bar;

use strict;
use Foo;

1;

Bar->foo() は、Foo で定義されているのに、@ISA の再帰チェックでは見付けられない。
@ISA から発見出来なかったら、@ISA になくて %INC にあるクラスをついでに調べるとかも考えたけど、調べる序列もわからなければ、import してるかどうかも分からない。

ふーむ、もういちどじっくり考えたほうがいいなー…とか思ってたら、山科 氷魚さんから、Devel::Peek を使ったり、B を使ったりのワザを教えてもらった。
とりあえず自分用にメモメモ。

use strict;
use UNIVERSAL::require;
use B qw(svref_2object);

print defined_class('Bar', 'foo'), "\n";

sub defined_class {
    my($class, $method) = @_;
    $class->use or die $!;
    if (my $ref = $class->can($method)) {
        return svref_2object($ref)->GV->STASH->NAME;
    }
}

ｽｺﾞｽ!!!
超感動した！！！！！１１！

こんな素敵なやりとりが日々行なわれているこのチャンネルって、ホント素敵だなーって実感した。

17:44 <tokuhirom> このチャンネルでこんなに生産的な会話がなされたのは凄い久々だなぁ

ホントは、雑談以外の発言量が極めて少ないチャンネルだったりする。。。

これも知っておけ！vim 勉強会？

はてな技術勉強会で、id:secondlife が これだけは知っておけ！vim 勉強会というのをやってたので、空前の vim ブームにちょっとかぶせてみる。

これも知っておいたほうがもっといいよーって意味で、

• :r
• :!

あたりを。

:r /path/to/file

ってやると、カーソル位置に /path/to/file の中身が取り込めるよ！

:r `perldoc -ml Sledge::Pages::Base`

shell とかと同じで、`` でコマンドの実行結果が展開されるから、コマンドの実行結果がファイル名なら、そのファイルの中身が取り込めるよ！

:!ls -l /path/to/dir

とりあえず、:!、って打つとコマンドが打てて、結果が表示されるよ！

でもその下に
Hit ENTER or type command to continue
ってのが出るから、Enter 押すと消えちゃうんだよ！

ls とかの結果をカーソル位置のとこに取り込みたければ、

:r!ls -l /path/to/dir

みたいに複合技にすれば出来るよ！
つまり、さっきの `` のやつは、

:r!perldoc -m Sledge::Pages::Base

でも同じような動きしてくれるよ！


あと、:new とかはベタすぎるから解説しないよ！


うーん、空元気に乗せてやってみたけど、「これも知っておけ！」ってのはこんぐらいかな。
vimer のくせに、実はあんまし vim を使いこなせてないほうなのかも。。。

きのうの memcached ネタ

昨日、memcached の話がありましたが、その後、

のみまくし日記 - 続・memcachedで新しくキャッシュを保存できないの刑

のテストコードが再現した後、miyagawa さんが

subtechグループ - Bulknews::Subtech - memcached

というエントリを書いていて、id:ikebe と id:clouder と軽く論議した末、自分なりになんとなく理解した。

要するに、データサイズに応じて領域を確保する class が違ってて、んで、LRU は、サイズ別に完全に分けて走るから、極端に違うサイズのデータの場合は、slabs_alloc() → LRU → 再度 slabs_alloc() するけど、既に割当てられている領域には LRU が走らず、store する領域がなくなって、二度目の slabs_alloc() でも領域が確保出来なかったら out of memory になるみたいなはなし。。。

なんだね。たぶん。

なので、元々割当てられている領域に対して、極端に過少 or 過大なデータを突っ込もうとすると、memcached で占有するメモリ量が少ないと、領域ないからダメよーってなっちゃうってことか。

まぁ、何ギガも確保して memcached が動いてるから、そんなことには全然ならないけど、確保した量が少ないとありえるってことなのだろう。

ってことで、だいたい合ってるでしょうか。