PerlとDBIxでトランザクションのテストをするときに注意したいこと
複数のテーブルを操作するときトランザクションを貼る必要がありますよね？？
そこでよくTest::Mock::Guardなどのモジュールを使って
擬似的にエラーを吐かせたりするんですが、ちょっと詰まったとこがあったのでここにメモしておきます。
下の関数はとあるスキーマのレコードを2つ渡すとそのname属性を"c"と"d"に変更してくれるなんともクソみたいな関数です。
面倒臭かったので引数でエラーの制御をしちゃってます(ちゃんとTest::Mock::Guardモジュールを使いましょう！！)
#!/usr/bin/env perl use strict; use warnings; use utf8; use MySchema; use Test::More; run_test() if $ENV{ HARNESS_ACTIVE }; sub update_a_and_b { my ( $schema, $a, $b, $is_occurred ) = @_; $schema->txn_do( sub { $a->update( { name => 'c' } ); die if $is_occurred; $b->update( { name => 'd' } ); } ); return; } sub run_test { my $schema = MySchema->connect( 'DBI:mysql:database=my_schema;host=localhost;', 'username', 'password' ) or die 'Can not connect database $!'; # Create tables with Result classes. # "add_drop_table" option is executing "drop table" at beforehand. $schema->deploy( { add_drop_table => 1, } ); my $my_table_rs = $schema->resultset( 'MyTable' ); note( 'Not occurred error in transction.' ); { my $a = $my_table_rs->find_or_create( { name => 'a' } ); my $b = $my_table_rs->find_or_create( { name => 'b' } ); eval{ update_a_and_b( $schema, $a, $b, 0 ) }; note( "Error: $@" ) if $@; is( $a->name, 'c' ); is( $b->name, 'd' ); } note( 'Not occurred error in transction.' ); { my $a = $my_table_rs->find_or_create( { name => 'a' } ); my $b = $my_table_rs->find_or_create( { name => 'b' } ); eval{ update_a_and_b( $schema, $a, $b, 1 ) }; note( "Error: $@" ) if $@; is( $a->name, 'a' ); is( $b->name, 'b' ); } done_testing; return; }
一見、2回目のupdate_a_and_b関数でエラーが発生し、更新されていたaのname属性がロールバックされそうです。
それではテストを実行してみましょう。
akata:^_^[~/perl/dbix-transaction]$ prove -Ilib -v main.pl main.pl .. # Not occurred error in transction. ok 1 ok 2 # Not occurred error in transction. # Error: DBIx::Class::Schema::txn_do(): Died at main.pl line 21. not ok 3 # Failed test at main.pl line 64. # got: 'c' # expected: 'a' ok 4 1..4 # Looks like you failed 1 test of 4. Dubious, test returned 1 (wstat 256, 0x100) Failed 1/4 subtests Test Summary Report ------------------- main.pl (Wstat: 256 Tests: 4 Failed: 1) Failed test: 3 Non-zero exit status: 1 Files=1, Tests=4, 0 wallclock secs ( 0.02 usr 0.01 sys + 0.15 cusr 0.05 csys = 0.23 CPU) Result: FAIL
はい、エラー
実はDBのデータはちゃんとロールバックされるのですが、Resultオブジェクトのカラムは元に戻らないみたいなんですよね・・
なので、テストを行う前にきちんとデータをDBから引っ張ってきましょう。
データの取得はdiscard_changesメソッドで簡単にできます。
こうかな？？
note( 'Not occurred error in transction.' ); { my $a = $my_table_rs->find_or_create( { name => 'a' } ); my $b = $my_table_rs->find_or_create( { name => 'b' } ); eval{ update_a_and_b( $schema, $a, $b, 1 ) }; note( "Error: $@" ) if $@; $a->discard_changes; is( $a->name, 'a' ); is( $b->name, 'b' ); }
こっちのほうがいいかな？？
sub update_a_and_b { my ( $schema, $a, $b, $is_occurred ) = @_; # use Try::Tinyすること try { $schema->txn_do( sub { $a->update( { name => 'c' } ); die if $is_occurred; $b->update( { name => 'd' } ); } ); } catch { $a->discard_changes; $b->discard_changes; }; return; }
テスト以前に、後々処理が続く機能(そもそもそういうのはいいのか？？)のことを考えたら、
個人的には下かな〜と思うのですが、一応どちらでもテストは通りますよ。
akata:^_^[~]$ prove -Ilib -v main.pl main.pl .. # Not occurred error in transction. ok 1 ok 2 # Not occurred error in transction. ok 3 ok 4 1..4 ok All tests successful. Files=1, Tests=4, 1 wallclock secs ( 0.02 usr 0.00 sys + 0.18 cusr 0.04 csys = 0.24 CPU) Result: PASS
あと、たまにロールバックされる前にテストが呼ばれることもあったので、
きちんとロールバックされているか確認したほうがいいかもしれません。
ZshでChange DirectoryしたときにList Segmentsする
Zshでcdしたときにlsされると便利かな～って思って適当に実装してみた。
手っ取り早く考えたのがこれ
alias cd="cd $1 ls"
まあコレはちゃんと動かないんですけどね。
エイリアスは引数を取れないので、問答無用でホームディレクトリ帰され、lsに引数が渡されたことになります。
$ cd hoge/
これが
$ cd && ls hoge/
こうなる(┐「ε:)ｽﾞｺｰ====
次に考えたのがこれ
alias cd="cdls"
function cdls() {
cd $1 && ls
}
いけそうな気がする・・
cdls:1: maximum nested function level reached
が……駄目っ……!
コレはcdのエイリアスが有効であるため、再帰的にcdが呼ばれ続けてエラーを吐いている。
と言う訳でbuiltinを使いましょう。
builtinはユーザ実装の関数やエイリアスよりシェル・コマンドを優先的に実行するためのコマンドです。
alias cd="cdls"
function cdls() {
builtin cd $1 && ls
}
これでエイリアスのcdではなく、シェル・コマンドのcdが呼ばれるようになります。
akata:^_^[~]$ cd hoge bar foo hoge huga akata:^_^[~/hoge]$
(∩´∀｀)∩ﾜｰｲいけました。
ちなみにこれだとlsコマンドの方はエイリアスが有効になっているので、
既存のエイリアスを使い回せます。
後、確認していませんが多分Bashでもちゃんと動くと思います(ﾀﾌﾞﾝﾈ..)
参考URL
Linuxコマンド集 - 【 builtin 】 シェル・コマンドを優先して実行する：ITpro
ここに知りたいことは全部書いていました。
ZshをインストールするためのAnsible-Roleを書いた
AnsibleのRoleシリーズの第3弾はシェルスクリプトのZshです。
akatakun/ansible-role-zsh · GitHub
第1弾Git: GitをインストールするためのAnsible-Roleを書いた - Akata Works第2弾Vim: VimをインストールするためのAnsible-Roleを書いた - Akata Works第4弾Scala: ScalaをインストールするためのAnsible-Roleを書いた - Akata Works
そして、設定がめんどくさい基本ツールのRoleは全部書き終わったような気がします。
やはりほとんど第1弾と第2弾の使い回しです・・
でも、使い回しが容易であることもAnsibleの良いところだと思います（学習コストも低いですし・・）
話は逸れますが、
僕はこれらのリポジトリをPrivateリポジトリのSubModuleとして持っており、
ansible-playbookコマンド一発で環境構築ができるようにしています。
イメージとしてはこんな感じ？？
* ansible/ # Privateリポジトリ
* initialization.yml # Root Playbook
* roles/
* git/ # 第1弾
* vim/ # 第2弾
* zsh/ # 第3弾
まじsubmodule便利っす
と、まあ、
最初はログインシェルの変更までやるつもりでしたが、飽きちゃったんで設定ファイルのシンクまでです。
気が向いたら更新とTmuxとか他のツールのRoleも書いていこうかな(*´ڡ`●)
というかさっさとScalaやらねば・・
perl: warning: Setting locale failed.
MacからSSHでCentOSに接続してPerlを実行すると以下のエラーが出た。
perl: warning: Setting locale failed.
perl: warning: Please check that your locale settings:
LANGUAGE = (unset),
LC_ALL = (unset),
LANG = "ja_JP.UTF-8"
are supported and installed on your system.
perl: warning: Falling back to the standard locale ("C").
現在のロケールの設定の中にインストールされていないロケールがあることが原因らしい。
現在のロケールの設定はlocaleコマンドで確認できるので確認するといい。
インストールされていなければついでにインストールしてしまおう。
localedef -f UTF-8 -i ja_JP ja_JP.UTF-8
根本的なことをいうと、単純にMacの設定を引き継いでいるからってこともある。
"/etc/ssh_config"ファイルから以下の行をコメントアウトするといい。
Host * SendEnv LANG LC_*
ロケールの問題なので他のコマンドでも発生するかも・・
参考URL
タイピングゲームを自動化するスクリプトを組んだった
今更ながら、YAPC::ASIA 2011の竹迫さんの発表を見て興味を持ったので、
Win32::GuiTestモジュールを触ってみました。
まあ、.NET Framework使えよって話ですがね。
せっかくオープンソース化されたので、時間があれば読んでおきたいな。
開発環境はCygwinとStrawberry Perlです。
Image MagickやImage::Magickモジュールのインストールがめんどうだった。
ちゃんと32Bitで統一しよう(；´Д｀)=3
竹迫さんが発表で仰っていましたが、
タイピングゲームを自動化すると面白そうだったので自動化しました。
画像ファイルとスクリーンショットをマッチングする簡単な仕組みですが、
X座標でソートして一気に打ち込むのはうまく出来たと思う。
sub match_words { my ( $screenshot, $words ) = @_; my %match_words; for my $word ( keys %$words ) { my @coords = $screenshot->match( $words->{ $word }, multiple => 1 ); my @xs = @coords[ grep { $_ % 2 == 0 } 0 .. $#coords ]; $match_words{$_} = $word for @xs; } return \%match_words; }
これを某サイトで試したところランキングトップを超えるスコアを出せました(^ρ^)
恐らく画像ファイルさえ用意すれば、ほとんどのサイトで動くと思いますが、
ブラウザの解像度やエリアシングの有無でぱたりと動かなくなりますorz
最後に、、ランキング荒らしちゃ駄目だよ
参考サイト
VimをインストールするためのAnsible-Roleを書いた
最近忙しくてちょっとペースが落ちてきているのが気になるakataです。
気が付いたら社会人も二年目になっていました。
今回は前回に引き続き、AnsibleでVimをインストールするためのRoleを書きました！！
と言っても、ほとんどGitの使い回しですが・・(^_^;)
一応、".vimrc"ファイルと".vim/"ディレクトリのシンクまでできます。
akatakun/ansible-role-vim · GitHub
第1弾Git: GitをインストールするためのAnsible-Roleを書いた - Akata Works第3弾Zsh: ZshをインストールするためのAnsible-Roleを書いた - Akata Works第4弾Scala: ScalaをインストールするためのAnsible-Roleを書いた - Akata Works
あと、Role内の変数名はRole名を付けるのが良いっぽいので、GitのRoleにも少し修正を加えました。
よーし、残りはZshのRoleを書いたら終わりかなー(；´∀｀)=3
