Error.pm
挙動確かめる用。ちなみに Exception::Class だと pacakge をわざわざ明示的に割り当てる必要は無い。
#!/usr/bin/perl package ThrowableProcess::Exception; use base qw(Error::Simple); package ThrowableProcess::FirstException; use base qw(ThrowableProcess::Exception); package ThrowableProcess::SecondException; use base qw(ThrowableProcess::Exception); package ThrowableProcess; use strict; use warnings; use Carp::Clan; use Error qw(:try); sub do_something { my ($class, $is_first, $is_second) = @_; $is_first = 0 unless (defined $is_first && $is_first); if ($is_first) { throw ThrowableProcess::FirstException 'first exception!!!'; } elsif ($is_second) { throw ThrowableProcess::SecondException 'second exception!!!'; } else { croak 'normal croaking'; } } package main; use Carp; use Error qw(:try); use Perl6::Say; my @cases = ( [ 1, 0 ], [ 0, 1 ], [ 0, 0 ], ); for my $case (@cases) { my ($is_first, $is_second) = @$case; try { ThrowableProcess->do_something($is_first, $is_second); } catch ThrowableProcess::FirstException with { my $e = shift; say $e->text; } catch ThrowableProcess::SecondException with { my $e = shift; say $e->text; } otherwise { my $e = shift; croak $e; } finally { say "finally"; }; }
throw とか catch とかは Klass->method と method Klass と同様で、しかもそれらがチェインしてますので、途中で ";" とか入れちゃ駄目。
初めての Q4M, Test::mysqld を使ったテストの準備
id:kazuhooku さんの指摘 *1 を受けて transaction してた所を修正。AutoCommit をとりあえず 1 にしておきました。
#!/usr/bin/perl use strict; use warnings; use DBI; use Perl6::Say; use SQL::Abstract; use SQL::Abstract::Plugin::InsertMulti; use Test::More; use Test::mysqld; my $m = Test::mysqld->new( my_cnf => +{ 'skip-networking' => '', }, ); my $dbh = DBI->connect('dbi:mysql:dbname=test;mysql_socket=' . $m->base_dir . '/tmp/mysql.sock', 'root', '', +{ AutoCommit => 1, RaiseError => 1, }); ok($dbh); isa_ok($dbh, 'DBI::db'); my @setup_queries = ( q|INSTALL PLUGIN queue SONAME 'libqueue_engine.so'|, q|CREATE FUNCTION queue_wait RETURNS INT SONAME 'libqueue_engine.so'|, q|CREATE FUNCTION queue_end RETURNS INT SONAME 'libqueue_engine.so'|, q|CREATE FUNCTION queue_abort RETURNS INT SONAME 'libqueue_engine.so'|, q|CREATE FUNCTION queue_rowid RETURNS INT SONAME 'libqueue_engine.so'|, q|CREATE FUNCTION queue_set_srcid RETURNS INT SONAME 'libqueue_engine.so'|, q|CREATE TABLE qt (id int unsigned not null, msg text not null) engine=queue|, ); eval { for (@setup_queries) { $dbh->do($_); die $dbh->errstr if ($dbh->err); } }; if ($@) { warn $@; exit; } my @queue = ( [1, 'a'], [2, 'b'], [3, 'c'], ); eval { my $sql = SQL::Abstract->new; my ($stmt, @bind) = $sql->insert_multi('qt', [qw/id msg/], [ @queue ]); $dbh->do($stmt, undef, @bind); }; if ($@) { warn $@; exit; } is_deeply($dbh->selectall_arrayref('select id, msg from qt'), \@queue); $dbh->selectrow_arrayref('select queue_wait(?)', undef, 'qt'); note(explain($dbh->selectall_arrayref('select id, msg from qt'))); $dbh->selectrow_arrayref('select queue_end(?)', undef, 'qt'); note(explain($dbh->selectall_arrayref('select id, msg from qt'))); done_testing;
とりあえずこんな感じでどうか。
SQL::Abstract::Plugin::InsertMulti
作ってみました。元ネタは MySQLにおけるbulk insert と bulk update - 金利0無利息キャッシング – キャッシングできます - subtech です。bulk insert, bulk update *1 が出来ます。
- SQL-Abstract-Plugin-InsertMulti-0.05 - add mysql bulk insert supports for SQL::Abstract - metacpan.org
- GitHub - zigorou/p5-sql-abstract-plugin-insertmulti: bulk insert and update support for SQL::Abstract
使い方は非常に簡単で、t/01_basic.t とか見て頂けるとすぐ分かるかと思いますがこんな感じです。
use strict; use warnings; use Data::Dump qw(dump); use Perl6::Say; use SQL::Abstract; use SQL::Abstract::Plugin::InsertMulti; my $sql = SQL::Abstract->new; my ($stmt, @bind) = $sql->insert_multi( 'app_data', [qw/app_id guid name value created_on updated_on/], [ [1, 1, 'score', 100, \'UNIX_TIMESTAMP()', \'UNIX_TIMESTAMP()'], [1, 1, 'ranking', 3, \'UNIX_TIMESTAMP()', \'UNIX_TIMESTAMP()'], [1, 2, 'score', 200, \'UNIX_TIMESTAMP()', \'UNIX_TIMESTAMP()'], [1, 2, 'ranking', 2, \'UNIX_TIMESTAMP()', \'UNIX_TIMESTAMP()'], [1, 3, 'score', 300, \'UNIX_TIMESTAMP()', \'UNIX_TIMESTAMP()'], [1, 3, 'ranking', 1, \'UNIX_TIMESTAMP()', \'UNIX_TIMESTAMP()'], ], ); say dump($stmt, \@bind);
とか実行すると、
(
"INSERT INTO app_data ( app_id, guid, name, value, created_on, updated_on ) VALUES ( ?, ?, ?, ?, UNIX_TIMESTAMP(), UNIX_TIMESTAMP() ), ( ?, ?, ?, ?, UNIX_TIMESTAMP(), UNIX_TIMESTAMP() ), ( ?, ?, ?, ?, UNIX_TIMESTAMP(), UNIX_TIMESTAMP() ), ( ?, ?, ?, ?, UNIX_TIMESTAMP(), UNIX_TIMESTAMP() ), ( ?, ?, ?, ?, UNIX_TIMESTAMP(), UNIX_TIMESTAMP() ), ( ?, ?, ?, ?, UNIX_TIMESTAMP(), UNIX_TIMESTAMP() )",
[
1,
1,
"score",
100,
1,
1,
"ranking",
3,
1,
2,
"score",
200,
1,
2,
"ranking",
2,
1,
3,
"score",
300,
1,
3,
"ranking",
1,
],
)って感じになります。その後すぐに DBI の do に渡せる感じですな。
元の id:mala さんの奴のコードを丸っとパクる事から始めたんですが、結局全部書き直してしまいました。
- SQL::Abstract の値の変換 (ScalarRef ならリテラルとして扱うとかそういうの) が適用されるように直した
- ON DUPLICATE KEY UPDATE 以下のパラメータも update() の時のパラメータのように設定出来るようにした
- update_multi() の時に、元のデータのフィールドが全部適用されちゃうのがちょっと嫌だったので、除外指定出来るようにした
- SQL::Abstract::LimitOffset 使ってて、これが継承してる奴だから横槍入れて適用出来るようにした
とかですかね。
とりあえずテーブル名が app_data ってのに特に意味はありません。悪しからず。
*1: ON DUPLICATE KEY UPDATE を利用した INSERT
Identity Conference #6 開催告知
にて開催告知を出しました。
で今のところ勝手に決めた仮タイトル。
- 何か (仮) - (hiroki さん)
- OpenID Contract Exchange の現在 (仮) (=nat さん)
- OpenID UX (仮) (=ritouさん)
- OpenSocial RESTful API と OAuth (仮) (=zigorou)
UX の仕様なんだけどこれは全然読んだこと無いので Identity 界の若手ホープである id:ritou さんに話して頂けたらなとか思うのですが、ついでに OAuth (と Hyblid) についても。
また =nat さんには Contract Exchange と Artifact Binding についてお話頂けると幸い。
とりあえず自分は OpenID からはちと離れて、最近仕事でやってる OpenSocial RESTful API の実装と OAuth について話せる範囲で話そうかなと思ってるけど、進捗次第でネタを変えるかも。
本当は XRD についても聞きたいのですが、=nat さん以外に Authority が見当たらないので誰か勇者求む。
なお、=tkudos 先生は今回はお休みです。予めご了承下さい^^
*1:誰？ｗ
YAPC Asia 2009 での発表資料「Database testing with MySQL::Sandbox」を公開します。
に置きました。
前半は以前に書いたブログのまとめ的な感じになっていて、後半は MySQL::Sandbox::Frontend と言うモジュールの話をしてみました。
make_sandbox コマンドの実行は結構重たくて、毎回 Sandbox 作っては消しと言うのをやる際にイライラが募るので、どっかからコピーしてきてよしなにやるような枠組みは必要なんだろうなと言うのと、本家自体に手を入れるか、1から作るかなど検討した方が良いかなと思いました。
YAPC 自体の感想はまた別途。
とりあえず関係者の皆様お疲れさまでした！
Yokohama.pm 出張版 in YAPC::Asia 2009 前夜祭
スピーカー一覧が出ましたねー。
id:amachang さんには何か最近の持ちネタを話して頂く予定です。メールしておいたのでご確認願います＞id:amachang
id:spiritloose さんには Schenker - RubyのSinatraのようなフレームワーク作成中 - spiritlooseのはてなダイアリー で紹介されている、Sinatra 風の WAF について話して頂きます。
他の題目に関しては、上記のリンクから確認して下さいね。
ところで、参加登録用の ATND にも書いてあるんですけど、YAPC のチケット持ってる人も持ってない人も ATND での登録をお願いしています。
懇親会の為の飲み物とか食べ物の発注上、困っちゃうので参加したいって方は、遠慮なくエントリして下さいね。
生 DBI ユーザーのための DBI Cookbook (2)
さて、まさか続編書くと思わなかったけど、d:id:ZIGOROu:20090731:1249050735 の続きです。
追記 (2009-08-15T00:30:56+09:00)
ちなみに、下記で紹介してる方法は一般的には DBI の資産がたくさん合ってモゴモゴな状況をどうするか…みたいな状況の人向けです。
一般的には宜しくないです、と言うことを踏まえてどうぞ。
DBI の拡張をサブクラスを用いて行う
Subclassing the DBI にちゃんと書いてあるんですが、DBI はサブクラスを作る為の環境が整っています。
論より証拠、実際の例です。
#!/usr/bin/perl use strict; use warnings; use DBI; use YAML; { package DBIx::Hideki; use base qw(DBI); package DBIx::Hideki::db; use base qw(DBI::db); package DBIx::Hideki::st; use base qw(DBI::st); use Time::HiRes qw(time); sub execute { my ($self, @bind_params) = @_; my $start = time(); my $rv = $self->SUPER::execute(@bind_params); my $elapse = time() - $start; print STDERR sprintf('[Hideki Kimura] sql: %s, elapse: %f', $self->{Statement}, $elapse); return $rv; } } my $dbh = DBI->connect('dbi:mysql:dbname=test', 'root', '', +{ RootClass => 'DBIx::Hideki' }); my $sth = $dbh->prepare('SHOW TABLES'); $sth->execute; print Dump($sth->fetchall_arrayref(+{})); $sth->finish; $dbh->disconnect;
これを実行すると、
[Hideki Kimura] sql: SHOW TABLES, elapse: 0.000498--- []
素晴らしいですね。
解説
DBIx::Hideki クラスは DBI を継承してますから、
DBIx::Hideki->connect();
みたいなのは当然動くんですが、いちいち書き換えたくないですよね。その場合には connect 時のオプションで RootClass を指定すると、DBI 側が良しなにサブクラス化してくれます。*1
このようにするとソース自体の書き換えは、接続時のパラメータのみいじれば良く、設定ファイルなんかに書いてある場合はちょっと書き換えるだけで色んな拡張が出来ますね。
注意する点としては、
をそれぞれ継承したモジュールを作らないと駄目って所です。
それと connect 系のメソッドですが、connect 時に RootClass の解決をするため connect 自体を差し替える事は出来ません。
但し connect 後であれば、connected と言うメソッドをコールする事になっているので、
package DBIx::Hideki::db; use base qw(DBI::db); use YAML; sub connected { my ($self, $dsn, $user, $credential, $attrs) = @_; print STDERR "[Hideki Kimura] connected\n"; print STDERR Dump(+{ dsn => $dsn, user => $user, credential => $credential, attrs => $attrs, }); }
みたいな感じで接続直後のデータを受け取りホゲホゲする事が出来ます。
まとめ
今さっき、性質の悪い酔っ払い共から電話が掛かってきました！ｗ
自宅に居るって言ったら「KY」呼ばわりされました。ひどい！
*1: bless しなおしてるだけですが
