MySQL Replication with Test::mysqld
やってみたかったからついやってみた。
#!/usr/bin/perl use strict; use warnings; use Data::Dump qw(dump); use DBI; use Test::More; use Test::Exception; use Test::mysqld; use Test::TCP; sub setup_master { # http://dev.mysql.com/doc/refman/5.1/en/replication-howto-masterbaseconfig.html my $mysqld = Test::mysqld->new( auto_start => 2, mysqld => '/usr/sbin/mysqld', my_cnf => +{ 'port' => empty_port(), 'log-bin' => 'mysql-bin', 'server-id' => 1, }, ) or die($Test::mysqld::errstr); note( $mysqld->dsn ); # http://dev.mysql.com/doc/refman/5.1/en/replication-howto-repuser.html my $dbh = DBI->connect( $mysqld->dsn, 'root', '' ); $dbh->do( sprintf( q|CREATE USER '%s'@'%s' IDENTIFIED BY '%s'|, 'repl', '127.0.0.1', 'replpass' ) ) or die( $dbh->errstr ); $dbh->do( sprintf( q|GRANT REPLICATION SLAVE ON *.* TO '%s'@'%s'|, 'repl', '127.0.0.1' ) ) or die( $dbh->errstr ); return $mysqld; } sub setup_slave { my $master_mysqld = shift; # http://dev.mysql.com/doc/refman/5.1/en/replication-howto-slavebaseconfig.html my $mysqld = Test::mysqld->new( auto_start => 2, mysqld => '/usr/sbin/mysqld', my_cnf => +{ 'port' => empty_port(), 'server-id' => 2, }, ) or die($Test::mysqld::errstr); note( $mysqld->dsn ); my $dbh_master = DBI->connect( $master_mysqld->dsn, 'root', '' ); my $master_status = $dbh_master->selectrow_hashref( 'SHOW MASTER STATUS' ); my $dbh = DBI->connect( $mysqld->dsn, 'root', '' ); # http://dev.mysql.com/doc/refman/5.1/en/replication-howto-slaveinit.html $dbh->do( sprintf( q|CHANGE MASTER TO MASTER_HOST='%s', MASTER_PORT=%d, MASTER_USER='%s', MASTER_PASSWORD='%s', MASTER_LOG_FILE='%s', MASTER_LOG_POS=%d|, '127.0.0.1', $master_mysqld->my_cnf->{port}, 'repl', 'replpass', $master_status->{File}, $master_status->{Position}, ) ); $dbh->do(q|START SLAVE|); note( explain( $dbh->selectall_arrayref( 'SHOW SLAVE STATUS', +{ Slice => +{} } ) ) ); return $mysqld; } my $master_mysqld; lives_ok( sub { $master_mysqld = setup_master; }, 'setup_master() is success' ); my $slave_mysqld; lives_ok( sub { $slave_mysqld = setup_slave($master_mysqld); }, 'setup_slave() is success' ); my $dbh_master = DBI->connect( $master_mysqld->dsn, 'root', '', +{ RaiseError => 1, AutoCommit => 0, } ); isa_ok( $dbh_master, 'DBI::db' ); $dbh_master->do(q|CREATE DATABASE hidek|) or die($dbh_master->errstr); $dbh_master->do(q|USE hidek|) or die($dbh_master->errstr); $dbh_master->do( q|CREATE TABLE hidek ( id int not null primary key auto_increment, name varchar(32) ) ENGINE=InnoDB| ) or die($dbh_master->errstr); $dbh_master->do( q|INSERT INTO hidek(name) VALUES(?)|, undef, 'yakatabune' ) or die($dbh_master->errstr); $dbh_master->commit or die($dbh_master->errstr); note( explain( $dbh_master->selectall_arrayref(q|SHOW DATABASES|) ) ); sleep 10; my $dbh_slave = DBI->connect( $slave_mysqld->dsn, 'root', '', +{ RaiseError => 1, AutoCommit => 0, } ); note( explain( $dbh_slave->selectall_arrayref(q|SHOW DATABASES|) ) ); $dbh_slave->do(q|USE hidek|); note( explain( $dbh_slave->selectall_arrayref(q|SHOW TABLES|) ) ); note( explain( $dbh_slave->selectall_arrayref(q|SELECT * FROM hidek|) ) ); done_testing;
要約すると my.cnf で言うところの mysqld で設定出来る内容なら何でも出来ると思って良いと。
XML::Writer
今まで使ったこと無かったけど、これは便利だ。
#!/usr/bin/perl use strict; use warnings; use IO::String; use XML::Beautify; use XML::Writer; my $osns = 'http://ns.opensocial.org/2008/opensocial'; my $buffer = IO::String->new; my $writer = XML::Writer->new( NAMESPACES => 1, ENCODING => 'utf-8', OUTPUT => $buffer, PREFIX_MAP => +{ $osns => '', } ); my $response = +{ startIndex => 1, itemsPerPage => 2, totalResults => 100, entry => [ +{ id => '34KJDCSKJN2HHF0DW20394', name => +{ unstructured => 'Jane Doe', }, gender => 'female', }, +{ id => 'VMK92BFH3DNWRYX39673DF', name => +{ unstructured => 'John Smith', }, gender => 'male', }, ], }; $writer->startTag( [ $osns, 'response' ] ); render_xml( $writer, $response ); $writer->endTag( [ $osns, 'response' ] ); $writer->end; my $formatter = XML::Beautify->new(); $formatter->indent_str(' '); my $xml = $formatter->beautify($buffer->string_ref); print $xml; $buffer->close; sub render_xml { my ( $writer, $data ) = @_; for my $field ( keys %$data ) { my $val = $data->{$field}; if ( ref $val eq 'HASH' ) { $writer->startTag($field); render_xml( $writer, $data->{$field} ); $writer->endTag($field); } elsif ( ref $val eq 'ARRAY' ) { for my $entry (@$val) { $writer->startTag('entry'); $writer->startTag('person'); render_xml( $writer, $entry ); $writer->endTag('person'); $writer->endTag('entry'); } } else { $writer->startTag($field); $writer->characters($val); $writer->endTag($field); } } }
みたいなコードを書くと、
<response xmlns="http://ns.opensocial.org/2008/opensocial"> <entry> <person> <name> <unstructured>Jane Doe</unstructured> </name> <id>34KJDCSKJN2HHF0DW20394</id> <gender>female</gender> </person> </entry> <entry> <person> <name> <unstructured>John Smith</unstructured> </name> <id>VMK92BFH3DNWRYX39673DF</id> <gender>male</gender> </person> </entry> <startIndex>1</startIndex> <itemsPerPage>2</itemsPerPage> <totalResults>100</totalResults> </response>
って感じで出力される。
開催地別終電表
現行の関内開催に比較した場合です。平日の終電ドリブンの調査です。
行き先は独断と偏見で抽出しました。
関内
| 行き先 | 出発時刻 | 到着時刻 |
|---|---|---|
| 恵比寿 | 23:55 | 00:48 |
| 新宿 | 23:55 | 01:00 |
| 藤沢 | 00:12 | 00:46 |
| 鎌倉 | 00:12 | 00:49 |
| 溝の口 | 23:55 | 00:41 |
| 武蔵小杉 | 00:12 | 00:45 |
| 二俣川 | 00:12 | 00:45 |
横浜
| 行き先 | 出発時刻 | 到着時刻 | 滞在時間増減 |
|---|---|---|---|
| 恵比寿 | 00:23 | 01:09 | +00:28 |
| 新宿 | 00:07 | 01:00 | +00:12 |
| 藤沢 | 00:24 | 00:46 | +00:12 |
| 鎌倉 | 00:24 | 00:49 | +00:12 |
| 溝の口 | 00:08 | 00:41 | +00:13 |
| 武蔵小杉 | 00:40 | 01:00 | +00:28 |
| 二俣川 | 00:42 | 01:00 | +00:30 |
CPAN::Packager で version を変えずに release だけ increment したい場合
一応、インターフェースとしては存在してるんだけど、cpan-packager コマンド経由だとどうにもならない。
$ perl -d /usr/bin/cpan-packager --module OreOre::Module --builder RPM --conf /path/to/cpan-packager.yaml
DB<1> x use CPAN::Packager::Builder::RPM::Spec;
DB<2> b CPAN::Packager::Builder::RPM::Spec::build
DB<3> c
DB<3> n
DB<3> x $args
0 HASH(0xe1ff444)
'installdirs' => 'vendor'
'just-spec' => 1
'noperlreqs' => 1
'release' => '1.cpanpackager'
DB<4> x $args->{release} = '2.cpanpackager';
0 '2.cpanpackager'
DB<5> cCPAN::Packager::Builder::RPM::Spec の build メソッドの $args->{release} を勝手に書き換えると出来るっぽぃ。とか書くと id:dann さんが何とかしてくれるんじゃまいか。
と思ったら米欄にて、id:dann さんより cpan-packager.yaml で対応出来るらしいとの事。知らなかったっす＞＜
DeNA のエンジニアブログ始めました！あとセミナーもやりますよ！
今まで会社にエンジニアブログが無かった事が驚きなんですが、うちも遅まきながら始める事にしました。
モバゲータウンを代表として数々のウェブサイトを開発、運用しているノウハウなどを伝えていこうと思っております。皆さん是非 RSS リーダー等でご購読頂ければと思います。
そして、技術セミナーも始める事にしました。
ちなみに当初 atnd でイベント登録する際に日付を間違えて登録しちゃったんで、明日だと勘違いされてる方もいらっしゃるかもしれませんが、念のために言っておくと 3/16 です。お間違え無いようお願い致します。
初回は最近リリースしたばかりのモバゲーオープンプラットフォームと mixi プラットフォームについて、アーキテクチャや運用についてお話したいと思います。
当日会場でお会い出来るのを楽しみにしております。
今後とも宜しくお願い致します。
URI::Template::Restrict 0.04
コラボレータに加えて貰って、0.04 をさっき id:ikasam_a に ShipIt して頂きました。そのうち cpan コマンド等でインストール出来ると思います。id:ikasam_a++
URI::Template::Restrict なんですが、extract() の処理が process() と同様の厳格なルールになっていて、実際に使う際にちょっと困ってました。
例えば、OpenSocial の RESTful API でありがちそうな以下のような URI Template に対して実際の URI をぶつける例、
#!/usr/bin/perl use strict; use warnings; use Data::Dump qw(dump); use URI::Template::Restrict; my $t = URI::Template::Restrict->new( 'http://example.com/api/people/{guid}/{selector}{-prefix|/|personId}' ); my %uri_params = $t->extract( 'http://example.com/api/people/@me/@friends/100' ); print dump(\%uri_params);
これはまったく何もマッチしないんですよね。これは "@" が URI Template 的には vardefault って部分なんですが、この部分の process 時のルールが percent encoding または unreserved って決まってるのでこうなってる。面倒ですね。
と言う訳で extract の時だけルールを緩和して、期待通り、
{ guid => "\@me", personId => 100, selector => "\@friends" }
って感じで取れるようにしたのが 0.04 になります。
ちなみにモバゲーオープンプラットフォームの Avatar API って奴だと、まぁこんな感じの URI Template になります。
#!/usr/bin/perl use strict; use warnings; use Data::Dump qw(dump); use URI::Template::Restrict; my $t = URI::Template::Restrict->new( 'http://example.com/api/avatar/{-list|;|guid}/{selector}/{-join|;|size,view,emotion,dimension,transparent,type,extension}' ); my %uri_params = $t->extract( 'http://example.com/api/avatar/100;200;350/@self/size=large;view=entire;transparent=true' ); print dump(\%uri_params); __END__ { dimension => undef, emotion => undef, extension => undef, guid => [100, 200, 350], selector => "\@self", size => "large", transparent => "true", type => undef, view => "entire", }
みたいに取れますよっと。
0.03 より loose になってるので互換性の面で難がある場合がありますのでご注意下さいませ。
ちなみにこれで何をしたいかなんだけど、もちろん RESTful API で使うんですけど、HTTP::Router 使った API 専用の薄い WAF を作って使いたいってのがあって、その為にまずは extract が厳格過ぎるってのを直しつつ、次は HTTP::Router の Any::Moose を止めると言う方向性でやりたいなーなんて思ってたりします。
生 DBI ユーザーのための DBI Cookbook (4)
さてと、モバゲーオープンプラットフォームが先日やっと始まりました＾＾
みなさん是非遊んで下さいです。
d:id:ZIGOROu:20091125:1259163476 のさらに続編です。
ShowErrorStatement でエラー時に発行されていたクエリを表示する
#!/usr/bin/perl use Carp; use DBI; my $dbh; eval { $dbh = DBI->connect("dbi:mysql:db=test;host=localhost", "root", "", +{ RaiseError => 1, AutoCommit => 0, ShowErrorStatement => 1, PrintWarn => 0, PrintError => 0, }) or croak($DBI::errstr); $dbh->selectall_arrayref("SELECT id, name, town FROM hidek WHERE id = ? AND name = ?", undef, "over", "reaction") or croak($dbh->errstr); }; if ($@) { confess($@); }
ってやると、
DBD::mysql::db selectall_arrayref failed: Unknown column 'town' in 'field list' [for Statement "SELECT id, name, town FROM hidek WHERE id = ? AND name = ?"] at - line 14. at - line 17
こんな感じのエラーになります。PrintError => 0, PrintWarn => 0 とかになってないと STDERR にメッセージが出ちゃうのでそれは消しておきました。
ちなみに $dbh->{Statement}, $sth->{Statement} で直近のクエリ自体を取得する事が出来ます。
