今年個人的に一番衝撃的だったのはやっぱ、livedoor blogのPlack化です。技術的な側面もさることながら、ああいう近視眼的には何のメリットもないし、逆にデメリットの方が大きそうな案件にリソースを割くジャッジができる会社としての姿勢が本当に凄いなと。
use strict;で、まぁSET NAMES utf8を自動的に発行したいなーと思ったので、get_dbhに手を入れる
use DBI;
sub get_dbh {
DBI->connect_cached(....);
}
sub foo {
my $dbh = get_dbh();
$dbh->do(...);
}
sub bar {
my $dbh = get_dbh();
$dbh->do(...);
}
foo();
bar();
....
sub get_dbh {
my $dbh = DBI->connect_cached(...);
$dbh->do("SET NAMES 'utf8'");
return $dbh;
}
そうするとget_dbh()内で DBIハンドル自体はconnect_cached()でキャッシュされた同じハンドルが返ってくるのだが、毎回SET NAMES 'utf8'が発行される。これは無駄だし、例えば一つ手前のステートメントの状態を期待するコードを書くと破綻する：{
my $dbh = get_dbh();
$dbh->do("INSERT INTO ...");
}
{
my $dbh = get_dbh();
# get_dbh()にSET NAMES utf8がなければ、直前のステートメントはINSERT INTO
# get_dbh()にSET NAMES utf8があると、直前のステートメントは SET NAMES utf8
my $id = $dbh->{mysql_insertid}; # SET NAMES utf8の後なので、insertidは存在しない
}if (! $dbh->{MySuperSpecialFlag}) { # ERRRRRRORRRRRR
$dbh->{MySuperSpecialFlag} = 1; # ERRRRRRORRRRRR
$dbh->do("SET NAMES 'utf8'");
} ところがprivate_で始まるキーなら使える！これで勝つる！sub get_dbh {
my $dbh = DBI->connect_cached(...);
if (! $dbh->{private_my_super_special_flag}) {
$dbh->{private_my_super_special_flag} = 1;
$dbh->do("SET NAMES 'utf8'");
}
return $dbh;
} 
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />という指定があれば
my $res = $lwp->get("...");
print $res->header('Content-Type');
には上記のメタタグの値が入る。内部的には以下のようにメタタグの中身をHTTP::Headerオブジェクトに格納している$headers->push_header("Content-Type", "...");
<meta name="twitter:card" content="summary" />この値をヘッダに入れようとするわけだが、このname属性、コロンが入っている。ということはヘッダ名は・・・"X-Meta-Twitter:Card"。ぎゃー！これRFC違反！ヘッダの名前に":"を入れちゃいけない！そんなところでHeadParserの処理がおかしなところでとまってしまうのであります。
my $lwp = LWP::UserAgent->new(parse_head => 0);でもこれだとHTMLヘッドセクション内のヒントを使うな、って話になるんだけどまれに必要な時もあるし、それに段々twitter cardを実装しているサイトも増えてるし、おかげで僕は先日何時間も無駄にしたし・・・・ということでHTML::HeadParser::Liberalというモジュールを書いた。
# もしくは
# $lwp->parse_head(0);
use HTML::HeadParser::Liberal;これでtwitter:cardもパースして、X-Meta-Twitter-Cardというヘッダ名でHTTP::Headersオブジェクトからアクセスする事ができます。
Perl5 Census Japan 2013に回答いただいた皆様、ご協力ありがとうございました！知らなかった人のために説明しておくと、私が2013年4月7日から19日までの間アンケート形式で日本でのPerlの利用状態等を知りたいと思い回答を募りました。回答数は394でした。
なるほどねー、へー、と思いつつデータを見ていました。取り急ぎ今回はシンプルな回答の集計結果をお知らせしようと思います。これからさらに面白い解析は是非このエントリの最後にあるデータを使ってみていただけると嬉しいです。
続きを読むuse Scope::Guard;で、これをsubtestごとにやるってのが常態化するなら、全部t/Util.pm とかにまとめちゃえばいい（けどそのあたりはお好みで）。ちなみにScope::Guard使わなくても自分で簡単にガードオブジェクトは作れるので、依存関係を増やしたくない場合でもOK。
subtest "A context" => sub {
my $subject;
my $setup = sub {
$subject = Bar->new;
return Scope::Guard->new(sub {
undef $subject;
});
};
subtest 'foo_method' => sub {
subtest 'given xxxx arguments' => sub {
my $guard = $setup->();
....
# teardownの明記はいらない
};
};
};
/path/to/perl-5.16.3/bin/carton exec -- ....はて、と考えると/usr/local/bin/cpanmが存在していて、どうもそれを使っているくさい。/path/to/perl-5.16.3/bin にはパスを通してなかったので、そこで取り違えが起きたということみたい。
local $ENV{PATH} = join ":", perl_binpaths(), $ENV{PATH};
exec("carton", ... ) perl_binpath() は こんな感じuse Config ();
sub perl_binpaths {
my %hash = map {
($Config::Config{$_} => 1)
} qw(installbin installscript installsitebin installsitescript);
return keys %hash;
}
builder {
enable ...; # ミドルウェア
mount "/foo" => MyApp::Handler::Foo->new;
mount "/bar" => MyApp::Handler::Bar->new;
....
};
# pseudocodeだからこのまま使うなよ！
my %handlers = (
"/foo" => MyApp::Handler::Foo->new,
"/bar" => MyApp::Handler::Bar->new,
....
);
sub handle_psgi {
my $env = shift;
my $handler = $handlers{ $env->{PATH_INFO} };
if (! $handler) {
return [ 404, [], [] ];
}
$handler->handle_request($env);
}
builder {
enable ...; # ミドルウェア
enable ...;
\&handle_psgi;
};
use Plack::Request;
use URL::Encode; # URL::Encode::XSを入れておく事
{
no strict 'refs';
*Plack::Request::query_parameters = sub {
my $self = shift;
my $env = $self->env;
my $query = $env->{'plack.request.query'};
if ($query) {
return $query;
}
$env->{'plack.request.query'} =
Hash::MultiValue->new(@{URL::Encode::url_params_flat($env->{'QUERY_STRING'})});
};
}
# バックグラウンドに送るとかは適時ご自分でどうぞ
> stuid-server --host_id=1 --port=9001
> stuid-server --host_id=2 --port=9002
> stuid-server --host_id=3 --port=9003
> stuid-client --server 127.0.0.1:9001 --server 127.0.0.1:9002 --server 127.0.0.1:9003サーバーを複数用意しておけば一個が万が一詰まっても、次のヤツに行くようになってます。
111499979255802135
use Data::STUID::Client;IDの生成方法自体はSTFのそれと同じで、だいたい順番にならんだ64ビットの整数が返ってくるのでPKとかにいれてそのIDの順番で作成順序でソートしたのと同じ状態にしつつ、ユニークなIDをふれるという感じです。
my $client = Data::STUID::Client->new(
servers => [ qw(127.0.0.1:9001 127.0.0.1:9002 127.0.0.1:9003) ]
);
print $client->fetch_id, "\n";
plackup -s Twiggy -a app.psgi
# または twiggy -a app.psgi とか
use strict;最初のhexdigest() の呼び出しは "foo", "bar", "baz"の値を使って計算したMD5の値。次の呼び出しは違う値を作成し、その次もまた値は違う。
use Digest::MD5;
my $md5 = Digest::MD5->new;
$md5->add("foo");
$md5->add("bar");
$md5->add("baz");
warn $md5->hexdigest; # 6df23dc03f9b54cc38a0fc1483df6e21
$md5->add("hoge");
warn $md5->hexdigest; # ea703e7aa1efda0064eaa507d9e8ab7e
warn $md5->hexdigest; # d41d8cd98f00b204e9800998ecf8427e
my $portfolio = Stock::Portfolio->new( user_id => "lestrrat ");このような計算を必要とするなら過去30日分の株価をオブジェクト内にキャッシュしてるのはわかる。ただしここでも気をつけないといけないのはキャッシュするにしても銘柄コードをキーにしてキャッシュしないといけない。例えばインメモリでキャッシュするにしても以下のように"last_30days"のようなキーでキャッシュしてはいけない
while ( ... ) {
# 時折 NTTの過去一ヶ月の取得株価と任意の日の株価の差額をリストで欲しい
my @profit = $portfolio->get_profits_last_30days( 9432 );
# そのほか $portfolioで色々操作するから $portfolio自体は
# 使い回す。
}
sub get_profits_last_30days {
my ($self, $code) = @_;
...
$self->{last_30days} ||= $self->get_prices_last_30days( $code );
...
}
sub get_profits_last_30days {
my ($self, $code) = @_;
...
$self->{last_30days}->{$code} ||= $self->get_prices_last_30days( $code );
...
}
# 最もシンプル。変数に格納しておくあともう一つの方法としては関数開始時に格納してあるフィールドを初期化する、とかあるけど、そもそもただのキャッシュで、次に計算する値が同じ物になる確率が低いなら関数を抜けた時にちゃんとクリーンアップされてるほうが筋がいいと思う。
sub foo {
my $self = shift;
my $data = $self->calculate_some_data; # 重い処理
$self->bar( $data );
$self->baz( $data );
}
# どうしても $selfに入れたい (1) local
sub foo {
my $self = shift;
local $self->{data} = $self->calculate_some_data; # 重い処理
$self->bar; # $self->get_data(); とかでキャッシュされたデータにアクセス
$self->baz;
}
# どうしても$selfに入れたい (2) ガードオブジェクト
use Scope::Guard;
sub foo {
my $self = shift;
my $guard = Scope::Guard->new(sub {
delete $self->{data};
});
$self->{data} = $self->calculate_some_data; # 重い処理
$self->bar;
$self->baz;
}
use strict; use Data::STUID::Server;で、それらにアクセスするようにクライアントを設定する感じ
# perl server.pl <id> <port>
# perl server.pl 1 9001
# perl server.pl 2 9002
# とか Data::STUID::Server->run( port => $ARGV[1] || 9001, host => '127.0.0.1', host_id => $ARGV[0], );
use strict;
use Data::STUID::Client;
my $client = Data::STUID::Client->new(
servers => [ qw(
127.0.0.1:9001
127.0.0.1:9002
) ]
);
for (1..10_000) {
my $id = $client->fetch_id;
print "Got $id\n";
} とりあえずざっくり。
