新しいblogに移行しました

新ブログ "All Yout Bugs Are Belong To Ass" に移行しました!

2009-12-30

[Perl]Data::ModelをMouseでextendsしたけどあんまり意味なかった。というメモ。

表題のとおり、これだけでは意味が無いです。ただextendsしました。と言うだけの話。
後学の為のメモとして残します。

まず、Data::ModelをextendsしたMyDBクラス。

$ cat ./lib/MyDB.pm
package MyDB;

use Data::Model::Schema;

install_model member => schema {
key 'id';
columns qw(
id name sex age
);
};

use Mouse;
extends 'Data::Model';

__PACKAGE__->meta->make_immutable( inline_constructor => 0 );

no Mouse;

1;
__END__


MyDBクラスを使ってSQLite上のデータを書き換えるスクリプト。

$ cat hoge.pl
#!/usr/bin/perl

use FindBin;
use lib ("$FindBin::Bin/lib");
use MyDB;
use Data::Dumper;
use Data::Model::Driver::DBI;

my $dbfile = "$FindBin::Bin/mydb.sqlite3";
my $driver = Data::Model::Driver::DBI->new(
dsn => "dbi:SQLite:$dbfile",
);

my $db = MyDB->new;
$db->set_base_driver( $driver );
print Dumper( $db->lookup( member => 1 ) );
my $rec = $db->lookup( member => 1 );
$rec->name( 'YellowTurtle' );
$rec->update;

print Dumper( $db->lookup( member => 1 ) );


実行結果。

$ ./hoge.pl
$VAR1 = bless( {
'alias_values' => {},
'column_values' => {
'name' => 'ytnobody',
'id' => '1',
'sex' => '29',
'age' => '1'
},
'original_cols' => {},
'changed_cols' => {},
'model' => bless( {
'schema_class' => 'MyDB'
}, 'MyDB' )
}, 'MyDB::member' );
$VAR1 = bless( {
'alias_values' => {},
'column_values' => {
'name' => 'YellowTurtle',
'id' => '1',
'sex' => '29',
'age' => '1'
},
'original_cols' => {},
'changed_cols' => {},
'model' => bless( {
'schema_class' => 'MyDB'
}, 'MyDB' )
}, 'MyDB::member' );

2009-12-26

[Perl]Data::Model::Tutorial::JAを読もう

今更ながら、Data::Model::Tutorial::JAを読んだ。
で、Data::ModelのGJなところを再発見したのでメモ。

Schema定義からCREATE TABLEを発行できる


アプリのセットアップで手抜きできますね。

set_base_driverメソッドの存在


Data::ModelにDriver(DBIやらCache::Memcachedやら)を後付けで食わせることができます。
Driver定義は、DB1つのみであれば1つだけ定義すればOK。管理上も楽できそうです。
ある日突然上司から、DBをMySQLからSQLiteに移行するように言われたりしても、Driver定義だけ書き換えればOK。これでもう悩み無用です。

column定義はSchema定義と分離可能


column定義の使いまわしができます。同じような構造のcolumn定義を何度も書くようなアホらしいことを避ける事が可能です。

cacheを挟み込むことができるようになるらしい?


DBI や Memcached のストレージへのアクセスするさいに Memcached などのキャッシュを 挟む事が出来ます。の、予定。

そもそもDBへクエリを投げて、ステートメントハンドラを受け取るという処理は、Memcachedにおけるgetやset等と比較すると、決して軽いものではないです。
ここで予定されている仕組みが実装されると、そんなDBへの問い合わせの頻度自体を減らすことができ、結果的にアプリケーションの高速化およびDBサーバの負荷軽減につながります。

2009-12-24

[Perl]せっかくだから、俺はこのData::Modelを選ぶぜ!

ちょうど、「オレオレなO/Rマッパーを作るべきか。諦めてDBICの軍門に降るべきか・・・」などとボヤいていた矢先、yappoさんのエントリ http://blog.yappo.jp/yappo/archives/000703.html を読んで、試してみました。
もともとCDBIもDBICも肌に合わなくて、DBIx::SimpleというモジュールをMouseで拡張したりして使っていたんですが(そのせいで若干O/Rマッパーアレルギー気味だった)、今やすっかりData::Model厨となりつつあります。

何が良かったのか。完全に一人称視点で列挙してみます。

・テーブルごとにSchemaクラスを分けなくてよい。
CDBIもDBICもテーブルごとにクラス分けをするのが前提のようですが、そもそもそこまでする必要の無いことが殆どです。
Data::Model::SchemaはDSL的な記述でSchemaを定義できます。
そもそもCDBIもDBICもSchemaの定義がちっともエレガントとは思えない。オイラがこれまでO/Rマッパーを毛嫌いしていたのは、この辺に原因があります。

・Memcachedドライバがある。
今ブームのKVSをデータドライバとして扱えます。
Cache::Mamcached::Fastを食わせれば、"Memcached"もさることながら"Tokyo Tyrant"にだってデータを格納できるわけです。

・Q4Mドライバがある。
まだオイラはQ4M自体を本格的に触っていないものの、他のO/Rマッパーではおそらくサポートしていないであろうと思われる機能です。
これによって透過的にQ4Mを利用できるものと思われます。

どうでもいいけど、

>そんな手垢のついたものばっかり使ってるから君は世界三位の位置にいつまでたってもつけないんだよ。

と言っても、ちっとも嫌味に聞こえないのがすげえ。

2009-11-23

[Perl]Net::Twitter(::Lite)使って思ったこと

今回Cuitterというソフトを開発して思ったんだけど、現状テストコードはpmsetupのそれしかない状態。
これをさっさとどうにかしたいんだけど、テストを書こうにも以下のような懸念があって二の足を踏んでいる状態。

     
  • いちいちアカウントやらパスワードをテストのたびに入力させるのも嫌な感じだし

  •  
  • そもそも書き込み系のテストすると、勝手にツイートされることになるのでNG。

  •  
  • 今後実装していこうと思っているフォローまわりのテストで、実データに手を入れるのはNGすぎる。



これについてNet::Twitter(::Lite)のドキュメントを漁ってみたけど、残念ながら有効と思われる記述は見受けられなかった。オイラの能力不足で見落としているのかもしれないけど。

漠然とした解決イメージとしては、APIサーバのレスポンスをエミュレーションしてやるのがいいのかな、と考えているけど、どうだろう。

あとテスト関係ないけど、

     
  • OAuth認証のセキュリティがある意味ザルすぎ(エンドユーザには全く実害はないが、開発者的には本当に目を疑ってしまうものだった)

  • でもOAuth使わないとwebからの投稿扱いになるので、それも嫌だ。


なんていうジレンマにも悩まされている。せめて公開鍵方式の認証方法を取り入れてくれないと、さすがに心許ない。

2009-11-19

[Perl]MojoをMouseでextendsしてみる

手始めに、MojoでMyAppをgenerateする。ここはMojo::Manual::GettingStartedに書いてあるのと同じ。

~/script/mojo$ mojo generate app MyApp


次に、MojoをMouseでextendsしたHamuChanというモジュールを用意する。

~/script/mojo/my_app$ cat lib/HamuChan.pm
package HamuChan;
use vars qw( $VERSION );
$VERSION = 0.001001;

use Mouse;
extends 'Mojo';
use Data::Dumper;

has action => ( is => 'rw', isa => 'Str' );

sub handler {
my ($self, $tx) = @_;
$self->action( 'default' );
$self->action( $tx->req->url->path->parts->[0] ) if defined $tx->req->url->path->parts->[0];
$tx->res->headers->header( 'x-powered-by', join( '/', __PACKAGE__, $VERSION ) );
}

no Mouse;
1;
__END__


lib/MyApp.pmを、HamuChanを利用するように変更する。

~/script/mojo/my_app$ cat lib/MyApp.pm
package MyApp;

use Mouse;
extends 'HamuChan';
use Data::Dumper;

after handler => sub {
my ($self, $tx) = @_;

# Hello world!
$tx->res->headers->content_type('text/plain');
$tx->res->body(
Dumper( [
$self->action,
$tx->res->headers->header( 'x-powered-by' )
] )
);
};

no Mouse;

1;
__END__


デーモンを起動。

~/script/mojo/my_app$ ./script/my_app daemon
Server available at http://127.0.0.1:3000.


ブラウザでアクセスすると、カスタマイズした箇所を表示する。

http://localhost:3000/aaaa

$VAR1 = [
'aaaa',
[
'HamuChan/0.001001'
]
];


ちゃんとactionが加わっている。パス指定が無い場合もHamuChanが取り回すようになっているので、

http://localhost:3000/

$VAR1 = [
'default',
[
'HamuChan/0.001001'
]
];


のようになる。

※Mouseって、最初からMooseX::NonMoose見たいな事が出来るんですね。

2009-11-18

[Linux]transmit timed out

オイラが管理するサーバが夜中に突然、PINGすら通らなくなった。
/var/log/mesaagesを見ると、

NETDEV WATCHDOG: eth0: transmit timed out


なんていう血文字が。こいつを頼りに調べると、先人の知恵ミラクルな解説に助けられた。

どうも、ネットワークの負荷が高い状況下において、TCP Segmentation
Offload(=TSO)が有効になっている場合、一部のハードウェアでネットワーク処理性能が低下するようだ。

そんな時には、TSOをオフにすると良いんだそうで。
# /sbin/ethtool -K eth0 tso off


2009-11-20 追記
TSOの有効状況を確認するには、下記のようにする。

# ethtool -k eth0
Offload parameters for eth0:
Cannot get device udp large send offload settings: Operation not supported
rx-checksumming: on
tx-checksumming: on
scatter-gather: on
tcp segmentation offload: on
udp fragmentation offload: off
generic segmentation offload: off

2009-10-31

[Perl]Gearman::Clientのleaktestでコケちゃうときは

perl-5.8.2という結構古い環境でGearmanを使おうとした際、Gearman::Clientのインストールにつまづいた。

Running make test
PERL_DL_NONLAZY=1 /usr/bin/perl "-MExtUtils::Command::MM" "-e" "test_harness(0, 'blib/lib', 'blib/arch')" t/*.t
t/00-use.t ............. ok
t/10-all.t ............. 1/33 Job 'fail_die' died: test reason at /root/.cpan/build/Gearman-1.10-PXw76r/t/worker.pl line 28.
t/10-all.t ............. ok
t/20-leaktest.t ........ "import" is not exported by the Exporter module
Can't continue after import errors at /root/.cpan/build/Gearman-1.10-PXw76r/t/lib/GearTestLib.pm line 4
BEGIN failed--compilation aborted at /root/.cpan/build/Gearman-1.10-PXw76r/t/lib/GearTestLib.pm line 4.
Compilation failed in require at t/20-leaktest.t line 14.
BEGIN failed--compilation aborted at t/20-leaktest.t line 14.
t/20-leaktest.t ........ Dubious, test returned 255 (wstat 65280, 0xff00)
No subtests run
t/30-maxqueue.t ........ ok
t/40-prefix.t .......... ok
t/50-wait_timeout.t .... 1/3 # Got result for 1
# Got result for 2
t/50-wait_timeout.t .... ok
t/51-large_args.t ...... ok
t/60-stop-if.t ......... 4/12 # Sleeping for 5 seconds
t/60-stop-if.t ......... ok
t/65-responseparser.t .. ok

Test Summary Report
-------------------
t/20-leaktest.t (Wstat: 65280 Tests: 0 Failed: 0)
Non-zero exit status: 255
Parse errors: No plan found in TAP output
Files=9, Tests=78, 95 wallclock secs ( 0.59 usr 0.10 sys + 10.14 cusr 0.91 csys = 11.74 CPU)
Result: FAIL
Failed 1/9 test programs. 0/78 subtests failed.
make: *** [test_dynamic] エラー 255
DORMANDO/Gearman-1.10.tar.gz
/usr/bin/make test -- NOT OK
Running make install
make test had returned bad status, won't install without force

よく見ると、

t/20-leaktest.t ........ "import" is not exported by the Exporter module
Can't continue after import errors at /root/.cpan/build/Gearman-1.10-PXw76r/t/lib/GearTestLib.pm line 4

と書いてあるので、Exporterモジュールを最新版にしてみる。

# cpan Exporter

で、いま一度Gearman::Clientのインストールにトライ。

Running make test
PERL_DL_NONLAZY=1 /usr/bin/perl "-MExtUtils::Command::MM" "-e" "test_harness(0, 'blib/lib', 'blib/arch')" t/*.t
t/00-use.t ............. ok
t/10-all.t ............. 1/33 Job 'fail_die' died: test reason at /root/.cpan/build/Gearman-1.10-22xMqA/t/worker.pl line 28.
t/10-all.t ............. ok
t/20-leaktest.t ........ skipped: This test requires Devel::Gladiator
t/30-maxqueue.t ........ ok
t/40-prefix.t .......... ok
t/50-wait_timeout.t .... 1/3 # Got result for 1
# Got result for 2
t/50-wait_timeout.t .... ok
t/51-large_args.t ...... ok
t/60-stop-if.t ......... 2/12 # Sleeping for 5 seconds
t/60-stop-if.t ......... ok
t/65-responseparser.t .. ok
All tests successful.
Files=9, Tests=78, 90 wallclock secs ( 0.51 usr 0.10 sys + 10.01 cusr 0.98 csys = 11.60 CPU)
Result: PASS
DORMANDO/Gearman-1.10.tar.gz
/usr/bin/make test -- OK

すんなりと入っちゃったよ。というお話し。

2009-10-30

[Perl]Mouseでメソッドアトリビュートをいじりたくなったものの

ざっくりMo(o|u)seのドキュメントを見た限り、そんなものは無いようだった。
そのかわり、Sub::Attributeというモジュールが適任っぽいのがわかった。

例によってチラ裏的なコード。


package HogeFuga;
use Data::Dumper;
use Mouse;
use Sub::Attribute;

sub myattr : ATTR_SUB {
print Dumper( { attr => [ @_ ] } );
}

sub hoge : myattr( 'a123', 'xyz' ) {
my $self = shift;
print Dumper( { arg => [ @_ ] } );
}
__PACKAGE__->meta->make_immutable;
no Mouse;

my $c = HogeFuga->new;
$c->hoge( 'aaa', 'bbb' );


結果は以下の通り。

$VAR1 = {
'attr' => [
'HogeFuga',
\*HogeFuga::hoge,
sub { "DUMMY" },
'myattr',
'\'a123\', \'xyz\''
]
};
$VAR1 = {
'arg' => [
'aaa',
'bbb'
]
};

2009-10-12

[daemontools]daemontoolsのインストールが手間くさいと感じる貴方へ

daemontools-install.sh version 0.76というものを作ってみました。

スクリプトの作成にあたって、下記のページを参考にさせていただきました。
Slackware 10.0 へ daemontools を組み込んでみる - EZ-NET

internet接続可能なホストであれば、damontools-0.76をある程度簡単にインストールできる。そんなスクリプトです。

使い方は至って簡単。

# ./daemontools-install.sh 


これだけです。

glibc-2.3.2以上の場合は、勝手にパッチもあてます。

2009-10-10

[Perl]balanceのラッパークラスNet::Balance

balanceという名のバランサーがあります。
こいつはシンプルかつ軽量であることが身上のようですが、わりと堅牢なので重宝しています。

で、最近こいつを動的に操作する必要があったので、Perlからコントロールできるように、Net::Balanceというモジュールをこさえてみました。Net-Balance-0.001002.tar.gz [DL]

単純にHTTPをバランシングする場合、

use Net::Balance;
my $balance = Net::Balance->new( listen_port => 80 );
$balance->balance_member( [qw[ 10.0.0.1 10.0.0.2:8080 ] ] );
$balance->run;


とかすればOK。

で、死活監視と組み合わせて、

use LWP::UserAgent;
my $agent = LWP::UserAgent->new;
my @target =
for ( 0 .. $#target ) {
my $node = $target[ $_ ];
my $res = $agent->get( "http://$node/" );
if ( $res->is_success ) {
# 生きてればチャネル有効
$balance->group( 0 )->channel( $_ )->enable;
}
else {
# 死んでればチャネル無効
$balance->group( 0 )->channel( $_ )->disable;
}
}


とかできます。でも、そもそもbalanceにhttpバランシングとかさせると、アクセス元IPが上書きされるのでお勧めできないです。せいぜいミドルウェアサーバやらキャッシュサーバの冗長化に使うくらいのものでしょうか。

2009-10-01

[Perl:テスト]B-OPCheck-0.29

以下の環境でコケました。

# uname -a
Linux cent5server 2.6.18-128.el5 #1 SMP Wed Jan 21 10:41:14 EST 2009 x86_64 x86_64 x86_64 GNU/Linux

# cat /etc/redhat-release
CentOS release 5.3 (Final)


現在の最新版 (0.29)の場合。

cpan[1]> install B::OPCheck

### 中略 ###

CPAN.pm: Going to build F/FL/FLORA/B-OPCheck-0.29.tar.gz

Checking if your kit is complete...
Looks good
Writing Makefile for B::OPCheck
cp lib/B/OPCheck.pm blib/lib/B/OPCheck.pm
/usr/bin/perl "-Iinc" /usr/lib/perl5/5.8.8/ExtUtils/xsubpp -typemap /usr/lib/perl5/5.8.8/ExtUtils/typemap -typemap /usr/lib64/perl5/site_perl/5.8.8/x86_64-linux-thread-multi/B/Utils/Install/typemap OPCheck.xs > OPCheck.xsc && mv OPCheck.xsc OPCheck.c
gcc -c -I/usr/lib64/perl5/site_perl/5.8.8/x86_64-linux-thread-multi/B/Utils/Install -D_REENTRANT -D_GNU_SOURCE -fno-strict-aliasing -pipe -Wdeclaration-after-statement -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -I/usr/include/gdbm -O2 -g -pipe -Wall -Wp,-D_FORTIFY_SOURCE=2 -fexceptions -fstack-protector --param=ssp-buffer-size=4 -m64 -mtune=generic -DVERSION=\"0.29\" -DXS_VERSION=\"0.29\" -fPIC "-I/usr/lib64/perl5/5.8.8/x86_64-linux-thread-multi/CORE" OPCheck.c
OPCheck.xs:16: error: redefinition of typedef ‘Perl_check_t’
ppport.h:3976: error: previous declaration of ‘Perl_check_t’ was here
make: *** [OPCheck.o] Error 1
FLORA/B-OPCheck-0.29.tar.gz
/usr/bin/make -- NOT OK
Running make test
Can't test without successful make
Running make install
Make had returned bad status, install seems impossible
Failed during this command:
FLORA/B-OPCheck-0.29.tar.gz : make NO


0.28の場合。

http://search.cpan.org/CPAN/authors/id/F/FL/FLORA/B-OPCheck-0.28.tar.gz
cpan[2]> install F/FL/FLORA/B-OPCheck-0.28.tar.gz

### 中略 ###

CPAN.pm: Going to build F/FL/FLORA/B-OPCheck-0.28.tar.gz

Checking if your kit is complete...
Looks good
Writing Makefile for B::OPCheck
cp lib/B/OPCheck.pm blib/lib/B/OPCheck.pm
/usr/bin/perl "-Iinc" /usr/lib/perl5/5.8.8/ExtUtils/xsubpp -typemap /usr/lib/perl5/5.8.8/ExtUtils/typemap -typemap /usr/lib64/perl5/site_perl/5.8.8/x86_64-linux-thread-multi/B/Utils/Install/typemap OPCheck.xs > OPCheck.xsc && mv OPCheck.xsc OPCheck.c
gcc -c -I/usr/lib64/perl5/site_perl/5.8.8/x86_64-linux-thread-multi/B/Utils/Install -D_REENTRANT -D_GNU_SOURCE -fno-strict-aliasing -pipe -Wdeclaration-after-statement -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -I/usr/include/gdbm -O2 -g -pipe -Wall -Wp,-D_FORTIFY_SOURCE=2 -fexceptions -fstack-protector --param=ssp-buffer-size=4 -m64 -mtune=generic -DVERSION=\"0.28\" -DXS_VERSION=\"0.28\" -fPIC "-I/usr/lib64/perl5/5.8.8/x86_64-linux-thread-multi/CORE" OPCheck.c
OPCheck.xs:16: error: redefinition of typedef ‘Perl_check_t’
ppport.h:3976: error: previous declaration of ‘Perl_check_t’ was here
make: *** [OPCheck.o] Error 1
FLORA/B-OPCheck-0.28.tar.gz
/usr/bin/make -- NOT OK
Running make test
Can't test without successful make
Running make install
Make had returned bad status, install seems impossible
Failed during this command:
FLORA/B-OPCheck-0.28.tar.gz : make NO


0.27だと入ります。

http://search.cpan.org/CPAN/authors/id/N/NU/NUFFIN/B-OPCheck-0.27.tar.gz
cpan[3]> install N/NU/NUFFIN/B-OPCheck-0.27.tar.gz

### 中略 ###

CPAN.pm: Going to build N/NU/NUFFIN/B-OPCheck-0.27.tar.gz

Checking if your kit is complete...
Looks good
Writing Makefile for B::OPCheck
cp lib/B/OPCheck.pm blib/lib/B/OPCheck.pm
/usr/bin/perl "-Iinc" /usr/lib/perl5/5.8.8/ExtUtils/xsubpp -typemap /usr/lib/perl5/5.8.8/ExtUtils/typemap OPCheck.xs > OPCheck.xsc && mv OPCheck.xsc OPCheck.c
gcc -c -D_REENTRANT -D_GNU_SOURCE -fno-strict-aliasing -pipe -Wdeclaration-after-statement -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -I/usr/include/gdbm -O2 -g -pipe -Wall -Wp,-D_FORTIFY_SOURCE=2 -fexceptions -fstack-protector --param=ssp-buffer-size=4 -m64 -mtune=generic -DVERSION=\"0.27\" -DXS_VERSION=\"0.27\" -fPIC "-I/usr/lib64/perl5/5.8.8/x86_64-linux-thread-multi/CORE" OPCheck.c
OPCheck.c: In function ‘XS_B__OPCheck_enterscope’:
OPCheck.c:210: warning: unused variable ‘mode’
OPCheck.xs: In function ‘XS_B__OPCheck_leavescope’:
OPCheck.xs:231: warning: suggest parentheses around assignment used as truth value
OPCheck.c:241: warning: unused variable ‘mode’
Running Mkbootstrap for B::OPCheck ()
chmod 644 OPCheck.bs
rm -f blib/arch/auto/B/OPCheck/OPCheck.so
gcc -shared -O2 -g -pipe -Wall -Wp,-D_FORTIFY_SOURCE=2 -fexceptions -fstack-protector --param=ssp-buffer-size=4 -m64 -mtune=generic OPCheck.o -o blib/arch/auto/B/OPCheck/OPCheck.so \
\

chmod 755 blib/arch/auto/B/OPCheck/OPCheck.so
cp OPCheck.bs blib/arch/auto/B/OPCheck/OPCheck.bs
chmod 644 blib/arch/auto/B/OPCheck/OPCheck.bs
Manifying blib/man3/B::OPCheck.3pm
NUFFIN/B-OPCheck-0.27.tar.gz
/usr/bin/make -- OK
Running make test
PERL_DL_NONLAZY=1 /usr/bin/perl "-MExtUtils::Command::MM" "-e" "test_harness(0, 'inc', 'blib/lib', 'blib/arch')" t/*.t
t/entersub.t .. ok
All tests successful.
Files=1, Tests=1, 1 wallclock secs ( 0.02 usr 0.02 sys + 0.03 cusr 0.02 csys = 0.09 CPU)
Result: PASS
NUFFIN/B-OPCheck-0.27.tar.gz
/usr/bin/make test -- OK
Running make install
Prepending /root/.cpan/build/B-OPCheck-0.27-jY3Jix/blib/arch /root/.cpan/build/B-OPCheck-0.27-jY3Jix/blib/lib to PERL5LIB for 'install'
Files found in blib/arch: installing files in blib/lib into architecture dependent library tree
Installing /usr/lib64/perl5/site_perl/5.8.8/x86_64-linux-thread-multi/auto/B/OPCheck/OPCheck.bs
Installing /usr/lib64/perl5/site_perl/5.8.8/x86_64-linux-thread-multi/auto/B/OPCheck/OPCheck.so
Installing /usr/lib64/perl5/site_perl/5.8.8/x86_64-linux-thread-multi/B/OPCheck.pm
Installing /usr/share/man/man3/B::OPCheck.3pm
Appending installation info to /usr/lib64/perl5/5.8.8/x86_64-linux-thread-multi/perllocal.pod
NUFFIN/B-OPCheck-0.27.tar.gz
/usr/bin/make install -- OK


2010-01-13 追記
現在も上記の状況が続いております。

2009-09-14

[Perl]過去の「テスト」記事を再度確認しました

[Perl]What I got in YAPC::Asia 2009, notes, and todo - use GFx::WebLog;によると、

Bug reports

id:charsbarさんのトークによれば,バグをブログの記事にするだけで放置するのは良くないとのこと。また,記事にしたあとその問題が修正された場合は,その記事内で報告したほうがいいようだ。検索でその記事に来た人はその記事しか見ない可能性があるからである。


とのことですので、過去の「テスト」記事を見直して、現時点でどうなっているのかを確認しました。
以下、その対象となった記事です。

2009-07-29

[Perl]タイムアウト処理を簡単に実装できるTime::Out

Time::Outというモジュールがあります。コイツはタイムアウト処理を実装するのに非常に重宝します。

以下のような、えらく時間のかかるロジックがあったとします。

sub slow_logic {
sleep int( rand( 40 ) ) + 10;
'OK';
}


で、例えばこのロジックを実行したときに、30秒以内に処理が終わらなければ強制的処理を終わらせundefを返すようにしたい、という場合は

use Data::Dumper;
use Time::Out qw( timeout );
my $logic = timeout 30 => \&slow_logic;
print Dumper $logic;


とします。
実行結果は下記の通り。

# time perl ./hoge.pl
$VAR1 = undef;

real 0m30.142s
user 0m0.130s
sys 0m0.010s

# time perl ./hoge.pl
$VAR1 = 'OK';

real 0m21.153s
user 0m0.130s
sys 0m0.020s

[Perl]List-MoreUtils-0.24はPerl5.8.8以前には入らない

7/27にList-MoreUtils-0.24がリリースされました。
しかしPerl5.8.8だと、testコケます。
Reports for List-MoreUtils

Running make test
PERL_DL_NONLAZY=1 /usr/bin/perl "-MExtUtils::Command::MM" "-e" "test_harness(0, 'blib/lib', 'blib/arch')" t/*.t
t/0_pod.t .............. ok
t/0_pod_coverage.t ..... skipped: Test::Pod::Coverage not installed
t/List-MoreUtils-pp.t .. ok
t/List-MoreUtils.t ..... Use of uninitialized value in numeric eq (==) at t/List-MoreUtils.t line 45.
Use of uninitialized value in numeric eq (==) at t/List-MoreUtils.t line 45.
Use of uninitialized value in numeric eq (==) at t/List-MoreUtils.t line 45.
t/List-MoreUtils.t ..... Failed 2173/2173 subtests

Test Summary Report
-------------------
t/List-MoreUtils.t (Wstat: 11 Tests: 0 Failed: 0)
Non-zero wait status: 11
Parse errors: Bad plan. You planned 2173 tests but ran 0.
Files=4, Tests=2164, 9 wallclock secs ( 2.58 usr 0.25 sys + 5.56 cusr 0.54 csys = 8.93 CPU)
Result: FAIL
Failed 1/4 test programs. 0/2164 subtests failed.


今のところPerl5.8.8では、0.22を使うしかなさそうです。
ちなみにMooseもこのモジュール使ってます。なので、Moose使うときには予めList-MoreUtils-0.22入れてからMooseを入れないとずっこけます。

2009-09-14 追記
現在、0.24は無かったことになっているようです。
その代わりに Developer Release として0.25_02がリリース済みです。こちらはPerl5.8.8でもテストが通る様ですが、メモリリークしてたりするようなので、もう少々0.22に頑張ってもらうことになりそうです。

2009-07-25

[電波]Bookmarklet「水も汁るいい男」と「穴口さん」

やったもん勝ちなネタ。
body書き換え系のブックマークレットです。

水も汁るいい男(みずもしるるいいおとこ)
水⇔汁変換。
ブックマークして、この辺に行ってから、水も汁るいい男を実行すると、いろんなものを汁だくにできます><

穴口さん(あなぐちさん)
穴⇔口変換。
水も汁るいい男同様、この辺のページでつかうと、ヤラシイ感じになります

2009-07-24

[Perl]MooseX::Types::DateTime::ButMaintained-0.08がテストコケる

MooseX::Types::DateTimeXを入れてるときにコケた。

Running make test
PERL_DL_NONLAZY=1 /usr/bin/perl "-MExtUtils::Command::MM" "-e" "test_harness(0, 'inc', 'blib/lib', 'blib/arch')" t/01_basic.t t/02_olson_abbreviations.t t/03_local_floating.t
t/01_basic.t ................ 12/?
# Failed test 'bad time zone'
# at t/01_basic.t line 89.
# Looks like you failed 1 test of 21.
t/01_basic.t ................ Dubious, test returned 1 (wstat 256, 0x100)
Failed 1/21 subtests
t/02_olson_abbreviations.t .. ok
t/03_local_floating.t ....... ok

Test Summary Report
-------------------
t/01_basic.t (Wstat: 256 Tests: 21 Failed: 1)
Failed test: 16
Non-zero exit status: 1
Files=3, Tests=28, 5 wallclock secs ( 0.09 usr 0.01 sys + 5.34 cusr 0.17 csys = 5.61 CPU)
Result: FAIL
Failed 1/3 test programs. 1/28 subtests failed.
make: *** [test_dynamic] エラー 255
ECARROLL/MooseX-Types-DateTime-ButMaintained-0.08.tar.gz
/usr/bin/make test -- NOT OK


では、テストコードから該当箇所を抜粋。


{
{
package Bar;
use Moose;

has time_zone => (
isa => "DateTime::TimeZone",
is => "rw",
coerce => 1,
);
}

my $tz = Bar->new( time_zone => "Africa/Timbuktu" )->time_zone;

isa_ok( $tz, "DateTime::TimeZone", "coerced string into time zone object" );

like( $tz->name, qr/^Africa/, "correct time zone" );

dies_ok { Bar->new( time_zone => "Space/TheMoon" ) } "bad time zone";
}


coerceまわりがおかしいっぽい。
では、coerceまわりのロジックをチェック。


our %coercions = (
DateTime => [
from Num, via { 'DateTime'->from_epoch( epoch => $_ ) }
, from HashRef, via { 'DateTime'->new( %$_ ) }
, from Now, via { 'DateTime'->now }
]

, "DateTime::Duration" => [
from Num, via { DateTime::Duration->new( seconds => $_ ) }
, from HashRef, via { DateTime::Duration->new( %$_ ) }
]

, "DateTime::TimeZone" => [
from Str, via {
# No abbreviation - assumed if we don't have a '/'
if ( m,/|floating|local, ) {
return DateTime::TimeZone->new( name => $_ );
}
# Abbreviation - assumed if we do have a '/'
# returns a DateTime::TimeZone::OffsetOnly
else {
my $offset = Olson::Abbreviations->new({ tz_abbreviation => $_ })->get_offset;
return DateTime::TimeZone->new( name => $offset );
}
}
]


, "DateTime::Locale" => [
from Moose::Util::TypeConstraints::find_or_create_isa_type_constraint("Locale::Maketext")
, via { DateTime::Locale->load($_->language_tag) }
, from Str, via { DateTime::Locale->load($_) }
]
);


おかしくね、これ。おかしいよ。
だって、dieするわけないよ。そりゃあテスト通りませんよね...

どうしてこうなった!どうしてこうなった!

しょうがないので、force installしましたとさ。おしまい。

2009-09-14 追記
0.09がリリース済みです。
無事にテストも通りましたよ!
good job!

Running make for E/EC/ECARROLL/MooseX-Types-DateTime-ButMaintained-0.09.tar.gz
Is already unwrapped into directory /home/azuma/.cpan/build/MooseX-Types-DateTime-ButMaintained-0.09

CPAN.pm: Going to build E/EC/ECARROLL/MooseX-Types-DateTime-ButMaintained-0.09.tar.gz

/usr/bin/perl "-Iinc" Makefile.PL --config= --installdeps=DateTime::TimeZone,0.96
Cannot determine perl version info from lib/MooseX/Types/DateTime/ButMaintained.pm
cp lib/MooseX/Types/DateTime/ButMaintained.pm blib/lib/MooseX/Types/DateTime/ButMaintained.pm
Manifying blib/man3/MooseX::Types::DateTime::ButMaintained.3pm
/usr/bin/make -- OK
Running make test
/usr/bin/perl "-Iinc" Makefile.PL --config= --installdeps=DateTime::TimeZone,0.96
Cannot determine perl version info from lib/MooseX/Types/DateTime/ButMaintained.pm
PERL_DL_NONLAZY=1 /usr/bin/perl "-MExtUtils::Command::MM" "-e" "test_harness(0, 'inc', 'blib/lib', 'blib/arch')" t/01_basic.t t/02_olson_abbreviations.t t/03_local_floating.t
t/01_basic.t ................ ok
t/02_olson_abbreviations.t .. ok
t/03_local_floating.t ....... ok
All tests successful.
Files=3, Tests=28, 3 wallclock secs ( 0.02 usr 0.01 sys + 2.23 cusr 0.08 csys = 2.34 CPU)
Result: PASS
/usr/bin/make test -- OK
Running make install
/usr/bin/perl "-Iinc" Makefile.PL --config= --installdeps=DateTime::TimeZone,0.96
Cannot determine perl version info from lib/MooseX/Types/DateTime/ButMaintained.pm
Installing /usr/local/share/perl/5.8.8/MooseX/Types/DateTime/ButMaintained.pm
Installing /usr/local/man/man3/MooseX::Types::DateTime::ButMaintained.3pm
Appending installation info to /usr/lib/perl/5.8/perllocal.pod
/usr/bin/make install -- OK

2009-07-15

[Perl]WWW::Mechanize-1.56がリリースされていた

既に昨日付けで1.58が出ているみたいだけど、こちらは1.56から大層な変更が加えられていないみたい

とりあえず気になったのが、Google group WWW::MechanizeでのLesterさんの発言。
http://groups.google.com/group/www-mechanize-users/browse_thread/thread/62772f07edcc17f9

[THINGS THAT MAY BREAK YOUR CODE]
For a while, Mech used HTTP::Response::Encoding to try to suss out
the proper encoding of the page it receives. Now, it lets
LWP::UserAgent do the work, and no longer requires
HTTP::Response::Encoding.


どうも、HTTP::Response::Encodingに頼っていたエンコード形式の検出を、LWP::UserAgentに任せることにしたらしい。
そもそもHTTP::Response::Encodingは、テストが通らない状態なので、この変更は非常にうれしい限り。

2009-09-14 追記
HTTP::Response::Encoding-0.06が2009-07-28にリリースされています。
こちらはきちんとテストが通りますので、ご安心ください^^

2009-07-13

[Perl]MIME::ToolsのテストMisc.tでコケるのは

t/Misc.t ............. 1/14
# Failed test 'bug 970725-DNA: QP use of RFC2049 guideline 8'
# at t/Misc.t line 78.
# got: '=46rom me'
# expected: '=46rom me=
# '

### 中略 ###

Test Summary Report
-------------------
t/Misc.t (Wstat: 1792 Tests: 14 Failed: 7)
Failed tests: 4-5, 7-11
Non-zero exit status: 7
Files=24, Tests=365, 33 wallclock secs ( 1.27 usr 0.36 sys + 29.08 cusr 1.15 csys = 31.86 CPU)
Result: FAIL
Failed 1/24 test programs. 7/365 subtests failed.
make: *** [test_dynamic] エラー 255
DONEILL/MIME-tools-5.427.tar.gz
/usr/bin/make test -- NOT OK

こんな具合でずっこけたので、ググってみる。

その中でも、cpanからMIME::WordDecoderをインストールしようとしてハマったのでメモ - KUMA TYPEをみてみると、
が、しかし、MIME::WordDecoderの最初のインストール時のログを今見てみるとしっかりチェックでMIME::Base64をversion 2.20からversion 3.03にアップグレードしろって出てるwww。
(現在はアップデートでversion 3.07になった)

さて、今回コケた環境をみてみる。
# perl -MMIME::Base64 -le 'print $MIME::Base64::VERSION'
2.21

古すぎ><

結果、MIME::Base64を最新にしたら、すんなりテストが通ってくれた。

2009-07-08

[Linux]postfix2.6 + cyrus-sasl2 で、コンパイル時の注意

Postfix で SMTP Auth(LDAP編)を参照。


ログとその対処方法

構築時に遭遇したログとその対処方法
"-DUSE_CYRUS_SASL" の付け忘れ
ログの内容
/var/log/syslog に

postfix/smtpd[14421]: [ID 947731 mail.warning] warning: unsupported SASL server implementation: cyrus
postfix/smtpd[14421]: [ID 947731 mail.crit] fatal: SASL per-process initialization failed
postfix/master[14405]: [ID 947731 mail.warning] warning: process /usr/libexec/postfix/smtpd pid 14421 exit status 1
postfix/master[14405]: [ID 947731 mail.warning] warning: /usr/libexec/postfix/smtpd: bad command startup -- throttling

原因
Postfix 2.3.* から "-DUSE_CYRUS_SASL" も指定する必要がある。
対処方法
CCARGS に "-DUSE_CYRUS_SASL" も付けて make する。

2009-06-22

[Perl]MooseX::Autouseというものをでっち上げてみた

SVNレポジトリ上のtrunkに置いておきました。poorで拙い"engrish"やら少なすぎるtest等など、遠慮なくダメ出ししてやって下さい程々に凹みますので;;

と、自虐はこの辺にしといて、そろそろまともにMooseなモジュールを組んでみたくて、やらかしました。MooseでAutouseしたかったんです。use HogeFugaとかいちいち書くのダルくなっただけですが。

こんな感じでの使い方を想定しています。

MyClass.pm



package MyClass;
use Moose;
with 'MooseX::Autouse';
no Moose;
1;
__END__


myscript.cgi



use MyClass;
use Data::Dumper;
my $c = MyClass->new;
my $dbi = $c->DBI->connect( qw( dbi:mysql:mydb:mydbhost user pass ) );
my $cgi = $c->CGI->new;
print $cgi->header( 'text/html' );
print '<html><body><pre>'. Dumper( $dbi ). '</pre></body></html>';


今改めて見直すと、本当にただMoose使いたかっただけなんだなあって思えますね><

2009-06-18

[Perl]HTTP::Response::Encoding-0.05がテストでこける

オイラのような端くれが、こんな記事を書いていいのだろうか。。。
ともあれ、後学のためにも書かねばいかんと思いますので、キリキリ書いていきます。
それにしても、dankogaiさん作のこのモジュールがテストでコケるとは。。。

まず、現象の出た環境。

# cat /etc/redhat-release
CentOS release 5.3 (Final)
# uname -m
x86_64
# uname -v
#1 SMP Wed Apr 1 09:10:25 EDT 2009
# uname -r
2.6.18-128.1.6.el5


この様な環境でテストを通すと、こんな風になりました。

# perl Makefile.PL
Checking if your kit is complete...
Looks good
Writing Makefile for HTTP::Response::Encoding
# make
cp lib/HTTP/Response/Encoding.pm blib/lib/HTTP/Response/Encoding.pm
Manifying blib/man3/HTTP::Response::Encoding.3pm
# make test
PERL_DL_NONLAZY=1 /usr/bin/perl "-MExtUtils::Command::MM" "-e" "test_harness(0, 'blib/lib', 'blib/arch')" t/*.t
t/00-load.t ....... 1/1 # Testing HTTP::Response::Encoding 0.05, Perl 5.008008, /usr/bin/perl
t/00-load.t ....... ok
t/01-file.t ....... 1/13
# Failed test '$res->charset eq 'EUC-JP''
# at t/01-file.t line 49.
# got: undef
# expected: 'EUC-JP'

# Failed test '$res->encoding eq 'euc-jp''
# at t/01-file.t line 51.
# got: undef
# expected: 'euc-jp'

# Failed test '$res->charset eq 'ISO-2022-JP''
# at t/01-file.t line 49.
# got: undef
# expected: 'ISO-2022-JP'

# Failed test '$res->encoding eq 'iso-2022-jp''
# at t/01-file.t line 51.
# got: undef
# expected: 'iso-2022-jp'

# Failed test '$res->charset eq 'Shift_JIS''
# at t/01-file.t line 49.
# got: undef
# expected: 'Shift_JIS'

# Failed test '$res->encoding eq 'shiftjis''
# at t/01-file.t line 51.
# got: undef
# expected: 'shiftjis'

# Failed test '$res->charset eq 'UTF-8''
# at t/01-file.t line 49.
# got: undef
# expected: 'UTF-8'

# Failed test '$res->encoding eq 'utf-8-strict''
# at t/01-file.t line 51.
# got: undef
# expected: 'utf-8-strict'
# Looks like you failed 8 tests of 13.
t/01-file.t ....... Dubious, test returned 8 (wstat 2048, 0x800)
Failed 8/13 subtests
t/boilerplate.t ... ok
t/pod-coverage.t .. ok
t/pod.t ........... ok

Test Summary Report
-------------------
t/01-file.t (Wstat: 2048 Tests: 13 Failed: 8)
Failed tests: 5-12
Non-zero exit status: 8
Files=5, Tests=19, 0 wallclock secs ( 0.02 usr 0.02 sys + 0.18 cusr 0.03 csys = 0.25 CPU)
Result: FAIL
Failed 1/5 test programs. 8/19 subtests failed.
make: *** [test_dynamic] エラー 255


取り敢えず、t/01-file.tを見てみます。


1 #!perl
2 #!perl -T
3
4 use strict;
5 use warnings;
6 use LWP::UserAgent;
7 use HTTP::Response::Encoding;
8 use File::Spec;
9 use Encode;
10 use Cwd;
11 use URI;
12 use Test::More tests => 13;
13
14 my $ua = LWP::UserAgent->new;

### 中略 ###

40 for my $charset (sort keys %charset){
41 my $uri = URI->new('file://');
42 $uri->path(File::Spec->catfile($cwd, "t", $filename{$charset}));
43 my $res;
44 {
45 local $^W = 0; # to quiet LWP::Protocol
46 $res = $ua->get($uri);
47 }
48 die unless $res->is_success;
49 is $res->charset, $charset, "\$res->charset eq '$charset'";
50 my $canon = find_encoding($charset)->name;
51 is $res->encoding, $canon, "\$res->encoding eq '$canon'";
52 }

### 以下略 ###


どうやらこのテストでは、LWP::UserAgentに'file://'なURIを食わせてgetさせています。そうして出てきたHTTP::Responseインスタンスの(HTTP::Response::Encodingで追加された)charsetメソッド及びencodingメソッドをキックして、出力を元にその動作正当性を検証しているようです。

では次に、lib/HTTP/Response/Encoding.pmを覗いてみます。


1 package HTTP::Response::Encoding;
2 use warnings;
3 use strict;
4 our $VERSION = sprintf "%d.%02d", q$Revision: 0.5 $ =~ /(\d+)/g;
5
6 sub HTTP::Response::charset {
7 my $self = shift;
8 return $self->{__charset} if exists $self->{__charset};
9 my $content_type = $self->headers->header('Content-Type');
10 return unless $content_type;
11 $content_type =~ /charset=([A-Za-z0-9_\-]+)/io;
12 $self->{__charset} = $1 || undef;
13 }
14
15 sub HTTP::Response::encoder {
16 require Encode;
17 my $self = shift;
18 return $self->{__encoder} if exists $self->{__encoder};
19 my $charset = $self->charset or return;
20 my $enc = Encode::find_encoding($charset);
21 $self->{__encoder} = $enc;
22 }
23
24 sub HTTP::Response::encoding {
25 my $enc = shift->encoder or return;
26 $enc->name;
27 }
### 以下略 ###


charsetメソッドは、HTTP::Response->headers->header('Content-Type')で得たcontent-typeヘッダを元に、11行目の正規表現にマッチした文字列を返しています。

encodingメソッドは、encoderメソッドが返すEncode::Encodingインスタンスのnameメソッドの結果を返しています。

つまり、

・encodingの動作はcharsetの動作に依存しており、
・charsetの動作はHTTP::Response::headersの動作に依存している

ことになります。従って、先のテストがこけたのは、LWP::UserAgentが("file://"なuriをgetした時の動作が)期待通りの動作をしていない為、という原因が考えられます。では、それを証明するためのテストを書いてみます。


# cat t/lwpua.t
use warnings;
use strict;
use Test::More tests => 7;
use FindBin;
use LWP::UserAgent;
use URI;

my @patterns = (
"http://www.yahoo.co.jp/",
"http://www.google.co.jp/",
"file://$FindBin::Bin/t-euc-jp.html",
"file://$FindBin::Bin/t-iso-2022-jp.html",
"file://$FindBin::Bin/t-shiftjis.html",
"file://$FindBin::Bin/t-utf-8.html"
);

my $ua = LWP::UserAgent->new;
my $res;

for ( @patterns ) {
$res = $ua->get( URI->new( $_ ) );
like(
$res->headers->header( 'Content-Type' ),
qr/^text\/html; charset=/,
$_. " content-type likes qr/^text\/html; charset=/"
);
}

$res = $ua->get( URI->new( "http://www.yahoo.co.jp/" ) );
open my $fh, ">", "$FindBin::Bin/yahoo.html" or die "could not open file";
print $fh $res->content;
close $fh;

$res = $ua->get( URI->new( "file://$FindBin::Bin/yahoo.html" ) );
like(
$res->headers->header( 'Content-Type' ),
qr/^text\/html; charset=/,
"file://$FindBin::Bin/yahoo.html content-type likes qr/^text\/html; charset=/"
);
unlink "$FindBin::Bin/yahoo.html";


上記テストの結果が以下の通りです。


# perl t/lwpua.t
1..7
ok 1 - http://www.yahoo.co.jp/ content-type likes qr/^text/html; charset=/
ok 2 - http://www.google.co.jp/ content-type likes qr/^text/html; charset=/
not ok 3 - file:///root/HTTP-Response-Encoding-0.05/t/t-euc-jp.html content-type likes qr/^text/html; charset=/
# Failed test 'file:///root/HTTP-Response-Encoding-0.05/t/t-euc-jp.html content-type likes qr/^text/html; charset=/'
# at t/lwpua.t line 22.
# 'text/html'
# doesn't match '(?-xism:^text/html; charset=)'
not ok 4 - file:///root/HTTP-Response-Encoding-0.05/t/t-iso-2022-jp.html content-type likes qr/^text/html; charset=/
# Failed test 'file:///root/HTTP-Response-Encoding-0.05/t/t-iso-2022-jp.html content-type likes qr/^text/html; charset=/'
# at t/lwpua.t line 22.
# 'text/html'
# doesn't match '(?-xism:^text/html; charset=)'
not ok 5 - file:///root/HTTP-Response-Encoding-0.05/t/t-shiftjis.html content-type likes qr/^text/html; charset=/
# Failed test 'file:///root/HTTP-Response-Encoding-0.05/t/t-shiftjis.html content-type likes qr/^text/html; charset=/'
# at t/lwpua.t line 22.
# 'text/html'
# doesn't match '(?-xism:^text/html; charset=)'
not ok 6 - file:///root/HTTP-Response-Encoding-0.05/t/t-utf-8.html content-type likes qr/^text/html; charset=/
# Failed test 'file:///root/HTTP-Response-Encoding-0.05/t/t-utf-8.html content-type likes qr/^text/html; charset=/'
# at t/lwpua.t line 22.
# 'text/html'
# doesn't match '(?-xism:^text/html; charset=)'
not ok 7 - file:///root/HTTP-Response-Encoding-0.05/t/yahoo.html content-type likes qr/^text/html; charset=/
# Failed test 'file:///root/HTTP-Response-Encoding-0.05/t/yahoo.html content-type likes qr/^text/html; charset=/'
# at t/lwpua.t line 31.
# 'text/html'
# doesn't match '(?-xism:^text/html; charset=)'
# Looks like you failed 5 tests of 7.


この結果から、LWP::UserAgent::headers->header( 'Content-Type' )の返り値は、"file://"なURIにおいて、"charset=ほげほげ"を含まないと言えそうです。

とりあえずオイラが言えるのは、t/01-file.tのテスト手法はこのままではまずい気がするってことと、現在のHTTP::Response::charsetは"file://"なURIに使わない方が良さそうだと言うことです。

ちなみにこの現象は、Task::Catalystをインストールしようとした際に起こりました。

2009-07-06 追記
rtでいくつかのパッチが公開され始めています。

2009-09-14 追記
7/28に0.06がリリースされていました。
テストもバッチリ通りました!
good job!

CPAN.pm: Going to build D/DA/DANKOGAI/HTTP-Response-Encoding-0.06.tar.gz

Checking if your kit is complete...
Looks good
Writing Makefile for HTTP::Response::Encoding
cp lib/HTTP/Response/Encoding.pm blib/lib/HTTP/Response/Encoding.pm
Manifying blib/man3/HTTP::Response::Encoding.3pm
/usr/bin/make -- OK
Running make test
PERL_DL_NONLAZY=1 /usr/bin/perl "-MExtUtils::Command::MM" "-e" "test_harness(0, 'blib/lib', 'blib/arch')" t/*.t
t/00-load.t ....... 1/1 # Testing HTTP::Response::Encoding 0.06, Perl 5.008008, /usr/bin/perl
t/00-load.t ....... ok
t/01-file.t ....... ok
t/boilerplate.t ... ok
t/pod-coverage.t .. ok
t/pod.t ........... ok
All tests successful.
Files=5, Tests=19, 2 wallclock secs ( 0.04 usr 0.00 sys + 0.27 cusr 0.03 csys = 0.34 CPU)
Result: PASS
/usr/bin/make test -- OK
Running make install
Manifying blib/man3/HTTP::Response::Encoding.3pm
Installing /usr/local/share/perl/5.8.8/HTTP/Response/Encoding.pm
Installing /usr/local/man/man3/HTTP::Response::Encoding.3pm
Appending installation info to /usr/lib/perl/5.8/perllocal.pod
/usr/bin/make install -- OK

2009-06-12

[Linux]Linux Software Searchは生きていた!

[Linux]やっぱりlss.eternity.ne.jpにアクセスできないあたりで、LSSへのアクセスができないと書きましたが、どうやらhttp://linux.softwaresearch.jp/へ移行したみたいですね。

何より、貴重なサイトが存続されていることに感謝です。

2009-06-01

[Perl]xor(^)演算子における注意

32bitシステムにおける"^"演算の結果は、正確さが保証されていない。


$ perl -le 'print int(3210987654^999900001010)'
998341671540
$ uname -m
x86_64



$ perl -le 'print int(3210987654^999900001010)'
1083979641
$ uname -m
i686


ビットシフト等も同様なので、要注意。

どうしても32bitシステムで事を成したいのであれば、Math::BigInt::GMP等のモジュールを利用するのが無難。

2009-05-15

[Perl]Encode/ConfigLocal.pmが無いと言われたら

なんか、「Can't locate Encode/ConfigLocal.pm」 とか言われたんです。この前。

で、ぐぐってみると、[perl] Encodeモジュールインストール後のCan't locate Encode/ConfigLocal.pm in @INC - おいぬま日報(不定期)に、書いてあったんです。

「enc2xs -C というコマンドを実行して、Encode/ConfigLocal.pmを生成すればいいようです。」


ほほぉ〜。どれどれ。

# enc2xs -C
require Encode::Detect;
require Encode::Detect::Detector;
require Encode::Detect;
require Encode::Detect::Detector;
require Encode::Detect;
require Encode::Detect::Detector;
require Encode;
require Encode::Config;
require Encode::Unicode;
require Encode::Symbol;
require Encode::TW;
require Encode::CJKConstants;
require Encode::GSM0338;
require Encode::JP;
require Encode::Encoding;
require Encode::CN;
require Encode::Encoder;
require Encode::Alias;
require Encode::Byte;
require Encode::EBCDIC;
require Encode::KR;
require Encode::Guess;
require Encode::KR::2022_KR;
require Encode::MIME::Header;
require Encode::MIME::Name;
require Encode::MIME::Header::ISO_2022_JP;
require Encode::CN::HZ;
require Encode::JP::JIS7;
require Encode::JP::H2Z;
require Encode::Unicode::UTF7;
require Encode::KR::2022_KR;
require Encode::MIME::Header;
require Encode::MIME::Header::ISO_2022_JP;
require Encode::CN::HZ;
require Encode::JP::JIS7;
require Encode::JP::H2Z;
require Encode::Unicode::UTF7;
require Encode;
require Encode::Config;
require Encode::Unicode;
require Encode::Symbol;
require Encode::TW;
require Encode::CJKConstants;
require Encode::GSM0338;
require Encode::JP;
require Encode::Encoding;
require Encode::CN;
require Encode::Encoder;
require Encode::Alias;
require Encode::Byte;
require Encode::EBCDIC;
require Encode::KR;
require Encode::Guess;
require Encode::KR::2022_KR;
require Encode::MIME::Header;
require Encode::MIME::Name;
require Encode::MIME::Header::ISO_2022_JP;
require Encode::CN::HZ;
require Encode::JP::JIS7;
require Encode::JP::H2Z;
require Encode::Unicode::UTF7;
$Encode::ExtModule{'Detect'} = "Encode::Detect";
/usr/lib/perl5/5.8.8/i386-linux-thread-multi/Encode
/usr/lib/perl5/5.8.8/Encode
Generating /usr/lib/perl5/5.8.8/i386-linux-thread-multi/Encode/ConfigLocal.pm...


無事にEncode::ConfigLocalが生成されたみたいです。

2009-04-21

[Perl]MooseX::Alienで、なんでもMoose

MooseX::Alienを使うと、非MooseなモジュールもMoose化できるらしい。

package MooseX::Safarize;
use Data::Dumper;
use Moose;
extends 'WWW::Mechanize';
with 'MooseX::Alien';

sub BUILD {
my $self = shift;
my @arg = @_;
$self->agent_alias( 'Mac Safari' );
}

before get => sub {
my ( $self, $uri ) = @_;
warn "GET $uri";
};

after get => sub {
my $self = shift;
warn "Status: ". $self->status. " ". length( $self->content ). " bytes DLed.";
};

no Moose;

my $c = MooseX::Safarize->new( timeout => 2 );
print Dumper $c->agent;
$c->get( 'http://www.cpan.org/' );


結果。

$VAR1 = 'Mozilla/5.0 (Macintosh; U; PPC Mac OS X; en-us) AppleWebKit/85 (KHTML, like Gecko) Safari/85';
GET http://www.cpan.org/ at ./safarize.pl line 15.
Status: 200 5810 bytes DLed. at ./safarize.pl line 20.

[Perl]Mooseでコンストラクタの挙動を変える

BUILDメソッドを定義することで対応できる。

package MyCar;
use Data::Dumper;
use Moose;

has 'speed' => ( is => 'rw', isa => 'Int' );

sub BUILD {
my $self = shift;
$self->speed( 50 ) if !$self->speed;
}

no Moose;

my $super_car = MyCar->new( speed => 200 );
my $normal_car = MyCar->new;

print "=== Super Car ===\n". Dumper $super_car;
print "=== Normal Car ===\n". Dumper $normal_car;

結果

=== Super Car ===
$VAR1 = bless( {
'speed' => 200
}, 'MyCar' );
=== Normal Car ===
$VAR1 = bless( {
'speed' => 50
}, 'MyCar' );

2009-04-14

[perl]MIME::LiteのRFC対応に難あり

ステキモジュールなMIME::Liteにおいて、RFC2822の4.5.3.1([Page 53]あたり)に準拠しきれていないと思われる現象に出くわした。

まず、このガサツなテストコードを見てほしい。
このコードでやっていることは非常に単純で、極端に長い文字列(1行)をMIME::Lite::encode_8bit() 及び MIME::Lite::encode_7bit() に渡し、返り値の1行あたりの最大文字列長が990以内であるかを検証している。

で、以下その結果(実行環境はubuntu-8.04LTS-amd64/perl-5.8.8)。


1..5
ok 1 - use MIME::Lite;
ok 2 - 1937 bytes gotten, hugest line 990 bytes.
not ok 3 - 2043 bytes gotten, hugest line 1052 bytes.
# Failed test '2043 bytes gotten, hugest line 1052 bytes.'
# at X001_Huge_Line.t line 19.
ok 4 - 1937 bytes gotten, hugest line 990 bytes.
not ok 5 - 2043 bytes gotten, hugest line 1052 bytes.
# Failed test '2043 bytes gotten, hugest line 1052 bytes.'
# at X001_Huge_Line.t line 19.
# Looks like you failed 2 tests of 5.


文字列長が1980より大きい行を与えた場合、改行を2つ以上補完すべきところが、1つしか補完されない。そのためtest3やtest5では、最大で2043文字もある行が残ってしまっている。

取り急ぎ、メンテナさんに報告しておくか。

2009-04-15 追記
RTにてチケットを発行。
初RTだったので、うまくレポート出来たかは何とも言えないが、'MIME-Lite'でチケット検索すれば出てくるようになった。
間違って、状態を一旦"着手"にしてしまったのはご愛嬌><

さらに追記
既に5年前からあるチケットでも、同様の指摘がされていた。うーむ。。。

2009-5-25 追記
テストコードを置いていたサーバのドメインが移行されたので、テストコードへのリンクを変更。

2010-2-17 追記
もう有名な話でしょうけど、今やMIME::Liteを使うのは「モダン」ではありません。その上、メンテナンスもされていないそうです。
Email::SimpleEmail::Send, Email::Sender を使うことをお勧めします。

2009-04-03

[OpenVZ]Solution for "Unable to open pty ..."

OpenVZ Forumに、ズバリな解決方法がpostされていた。

I have same trouble and this looks very strange. As solution (inside problematic VZ) simply add the line 'ptmx' in file /etc/udev/makedev.d/50-udev.nodes (for CentOS 5) and is works fine after reboot.

つまりVPSがCentOS5なら、

# echo 'ptmx' >> /var/lib/vz/root/[VEID]/etc/udev/makedev.d/50-udev.nodes
# vzctl reboot [VEID]

で解決。
なるほどねぇ。

[OpenVZ]cpanでテストが全コケするのを回避する方法

OpenVZのフォーラムでも回答されているけど、要するにリソースが不足しているからテストがコケる(というか、テストすらしない)わけです。

で試しに、コンテナに対し下記のようなチューニングを施して、コンテナ再起動後にDBIx::Simpleをcpanでインストールしてみたら、無事にテストを通過。インストールに成功しました。
# vzctl set 5001 \
--numproc 192 \
--numfile 3072 \
--shmpages 512M \
--kmemsize 32M:64M \
--save

2010-12-15 追記
今のご時世なら、cpanmを使うことで全て解決します。→[Perl]大抵のPerlerに恩恵を与えるcpanminus

2009-03-24

[ネットライフ]田村・・・じゃなくてtumblrつかってみた

YellowTumblr

なんだろう、とりあえずスクラップブック的な用途で使っていく方向。

[Parrot]Parrot1.0.0がリリースされてた

Parrot 1.0.0 "Haru Tatsu" Released!
「Haru Tatsu」って言葉の由来は何なのでしょね?「春立つ」?「春龍」?
まあどんな由来でも結構ですが。。。

2001年のエイプリルフールのネタが元になって開発されたVMも、ついに1.0.0がリリースされたわけです。2年くらい前から気にはなっていたものの、今ひとつ触れる機会を設けなかったので、詳細はまるで分からないんですけど。せいぜい「Perl6のVMになるはずのもの」という認識でしかありません。。。

ただ、Perlerの末汚しとしては、この際だからダウンロードしてドキュメントに目ェ通しながら、どんなものなのか把握しておきたい。

そんなわけで、たまにParrot関連のメモやらも残していきます。

追記
マイコミジャーナルで取り上げられていたんですね。
http://journal.mycom.co.jp/news/2009/03/24/008/index.html

2009-03-19

[ネットライフ]regexpでdis祭りの予感

過去にも同じような光景を見た気がするが、気のせいだろう。。。

「PHP使いはもう正規表現をblogに書くな」と言わせないでくれ - 404 Blog Not Found曰く、

正規表現って、プログラミング言語間の差が少ないサブ言語なのに、なぜ「PHP」がつくとダメ正規表現ばかり登場するのか。うんざりだ。


かなり煽っていますね。。。

で、はてブにおける問題のエントリのブックマーク状況。
はてなブックマーク > かなり使えるPHPの正規表現まとめ - IDEA*IDEA ~ 百式管理人のライフハックブログ ~

これは痛々しい。本当に便利だとおもってそのまま使いまわす雰囲気がある人たちが多数集まっていらっしゃる。また、この状況を皮肉っている人も少数見受けられる。

ブックマークする事自体にケチつける気はないし、他所様のソースを参考にするのも悪いことじゃないと思うんだけど、これらのregexpをちゃんと吟味しておいたほうがよさそうですよっと。

もっとも、今回のケースでは元ネタのregexpサンプルがあまりにもアレだったにもかかわらず、とくに吟味せずに取り上げたのが問題なんですがね。

色々考えさせられる一件です。。。

3/19 追記
要するに、ちょっと思考停止しすぎなんじゃないかと思った次第。
開発者なら、単純なチェックをさせるための正規表現は、自力で書けるようにしておきたいものです。

さらに追記
今見たら、かなり祭られている模様。たしかにあの煽りは蛇足と感じますけど、dankogaiらしいとも思います。

2009-03-09

[Linux]やっぱりlss.eternity.ne.jpにアクセスできない

以前に同じような記事を書いて、自分の所だけ見れていない様だったので削除したのだが、改めて別の環境からアクセスを試みてみたところ、やはりアクセス出来ない状態だった。

http://lss.eternity.ne.jp/ (09-03-09現在アクセス不能)

どういういきさつでこの様な状況になったのかご存知の方、いらっしゃいましたら、コメント下さい。

追記:
lss.eternity 失効でググったところ、07-09-03あたりには既に見れなくなっていた模様ですね。。。

09-06-12 追記:
どうやら生きているようです!

2009-02-24

[OpenVZ]"Unable to open pty..."とか云われ

vzctl enterできない時。

http://smbd.jp/diary/20070821.html経由で知った。

http://www.eukhost.com/forums/f29/vps-unable-open-pty-no-such-file-directory-2666/


1. Edit the file /etc/rc.sysinit of the VPS server

2. Comment the line
#/sbin/start_udev

3. Add the following lines after /sbin/start_udev:

/sbin/MAKEDEV tty
/sbin/MAKEDEV pty

4. Reboot your VPS
vzctl restart VEID

& you'd be all good :-)


そもそもudev使うのがダメなようなので、最初からこの設定をしておくと良さそう。

2009-02-18

[Perl]モダンPerl入門を概ね読んだ

国内のPerlハッカー達が既に書評を公開しているが、彼らの評する通り素晴らしい一冊である。
原稿をPODで書いたというのもまた、Perlハッカーらしい。

上述の通り、書評なんぞかいてもX番煎じなので、読んだ後のオイラ自身のコードに与(えた|るであろう)影響をサクッと羅列してみます。

オブジェクトシステム


従来 Class::Accessor::(Fast|Lvalue::Fast)
以降 Moose
やっとMoose::Roleを理解できた><
Moose自体に契約プログラミングの概念が取り入れられていて、非常に堅牢なコードを書けそう。
あと、無駄なテスト書かなくてよくなるんだから、そりゃ使いますわ。

外部アプリとの連携


従来 shを叩く
以降 XSをまず検討してみる
パフォーマンスがね。段違いなんですね。
で、マルチプラットフォームも視野に入ると、ほぼ一択なんじゃないかと。

テスト


従来 最近は、テストとコードを並行して書くようにしていた。(若干テスト先行で)
以降 Mooseの偉大さを知り、無駄な型テストを省略できるようになった。
テストコードを書く工数を減せたのは大きい。

ベンチマーク


従来 たまにしか取ってませんでした><
以降 ちゃんとベンチとります;;
処理の回数を減らすことが、処理速度向上の方法として効果が高い。
当たり前のことだけど、これ、言われるまであまり視野に無かったです;;
まあでも、memcachedやmemoize導入するのも、結局「マシンをうまくサボらせる為」に他なら無いんだよね。

他にも細かく影響を与えられてるかも。
とにかく、自分の席に常備することにしましたとさ。

2009-02-13

2009-01-31

[ネットライフ]Google先生ご乱心



どの検索結果にも、「このサイトはコンピュータに損害を与える可能性があります。」という文句がつけられている・・・ご乱心?

09-02-03 10:45 追記
Google Japan Blog: 全ての検索結果に「このサイトはコンピュータに損害を与える可能性があります。」というメッセージが表示された件について
slashdot.jp:先月末の Google の不具合、原因は人為的ミス
これは・・・><

2009-01-30

[Perl]型グロブやらシンボルテーブルについてのチラ裏

本当にチラ裏なんだけど、やっぱりよく忘れるので貼っておく。

code



#!/usr/bin/perl
use Data::Dumper;
use IO::Handle;

my $a = 'aaa';
${ $a } = 'hogehoge';
@{ $a } = qw/ foo bar baz / ;
%{ $a } = ( name => 'test', age => 21 );
*{ $a } = sub { return 'pooh!' };
open $a, './pee.pl';

print Dumper { package => *{ $a }{ PACKAGE } };
print Dumper { name => *{ $a }{ NAME } };
print Dumper { io => *{ $a }{ IO } };
print Dumper { format => *{ $a }{ FORMAT } };
print Dumper { glob => *{ $a }{ GLOB } };
print Dumper { scalar => *{ $a }{ SCALAR } };
print Dumper { array => *{ $a }{ ARRAY } };
print Dumper { hash => *{ $a }{ HASH } };
print Dumper { code => *{ $a }{ CODE } };
print Dumper $a->();

print Dumper [ *{ $a }{ IO }->getline ];

close $a;

sub doooo {
3;
}

for my $key ( keys %main:: ) {
print Dumper $key if *{ $main::{$key} }{ CODE };
}


結果



$VAR1 = {
'package' => 'main'
};
$VAR1 = {
'name' => 'aaa'
};
cannot handle ref type 15 at /usr/lib/perl/5.8/Data/Dumper.pm line 179.
$VAR1 = {
'io' => bless( , 'IO::Handle' )
};
$VAR1 = {
'format' => undef
};
$VAR1 = {
'glob' => \*::aaa
};
$VAR1 = {
'scalar' => \'hogehoge'
};
$VAR1 = {
'array' => [
'foo',
'bar',
'baz'
]
};
$VAR1 = {
'hash' => {
'name' => 'test',
'age' => 21
}
};
$VAR1 = {
'code' => sub { "DUMMY" }
};
$VAR1 = 'pooh!';
$VAR1 = [
'#!/usr/bin/perl
'
];
$VAR1 = 'doooo';
$VAR1 = 'aaa';
$VAR1 = 'Dumper';

2009-01-23

[生活]インフルエンザ

A型ウイルスにやられて、2日ほどダウン。
回復力が落ちたことにショックを覚えたorz

2009-01-20

[視点]もっとチケットという言葉を浸透させないか?

バグに至るまでの道のり - がるの健忘録を見て、切に思った。

まず「実装バグなのか?」という部分で、大抵の心ない人非人*2が予想しているよりも多くのハードルがあったりします。

(中略)

*2:えと…it(それ)とか呼んでみるのはどうかしらん? きっと彼らは「ITかぁそうかぁ俺たちが代表なんだなぁ」とか都合良く勘違いしてくれそうですしw。えと…「ITな人たち」「ITな方々」とかいう言い方?w


ここでいうITな方々に相当しそうな人たちって、概ね「開発者より権力のある、開発者ではない人」に相当するとおもう。仮にそうだとすると、潜在的にはかなり多くの人たちが該当する。

で、彼らが開発者に「バグだ」と言って持ってくるものって、大抵「バグかもしれない事象の報告」だったりするわけで。でも、「バグ」って言葉は認知され、発音しやすく、しかも衝撃的なので、皆こぞって「バグだ!」と言い続ける。
# 理由はもっと他にあるかもしれないけど、体験上よくあるパターンとして。

言うだけの人からすれば、まあそれで良いんだろうけど、「バグ」を出したとされる開発者からすれば、これは堪ったものではない。何が堪らんのかというと、バグかどうか分からん事象までバグ扱いされて、全部自身の責任にされ兼ねない。こりゃつらい。下手すると次の日から音信不通になるかもしれない。

開発者や「ITな方々」を含め、いろんな人が不機嫌になるくらいなら、最初から「バグ」なんて言葉を不用意に使わなければ良いだけの話だと思う。

「バグかもしれない事象の報告」や「修正要望」は、「バグ」ではなくて「チケット」ですぜ。

チケットについては、第3回:チケットドリブン開発でバグ削減!に詳しく説明があります。

2009-01-19

[Perl]モダンPerl入門を予約。

モダンPerl入門

予約。すげー楽しみ!

ちょうど、自分の理解がギリギリ及んでいない部分(Moose然り、XS然り...)をまるごとカバーしているような気がする。

また、テストに関する記述がある書籍は他にいくつか読んできたものの、どれも微妙というのが正直な感想。この本には、そういう意味でもかなり期待していたりする。

2009-01-01

[Perl]Email::Filterは無実です、オイラが悪かったです;;

過去に書いた記事 [Perl]Email::FilterとかEmail::Simpleでheaderメソッド使ってFromを取得するときの注意で、オイラが盛大に誤爆したことが明らかとなりました。

まず、[Perl]Email-Simple-2.004はちゃんとFromヘッダ処理できてたにもあります通り、Email::Simpleにおいて、$instance->header( "From" ); は正常に動作します。

さて、今回確認を行ったEmail::Filterについても、下記のような実証用コードを用意し、調べてみました。

test.pl



#!/usr/bin/perl
use Email::Filter;
use Data::Dumper;
my $email = Email::Filter->new;
print Dumper $email->header( 'From' );

見ての通り、以前書いた実証用コードをよりシンプルにしました。

また、手元に届いたスパムメール(^^;)を元に、Email::Filterのheaderメソッドのテスト用データを3パターンこさえてみました(元データがスパムなので、Fromを公開しておきます)。

テストデータ1(data_1.txt)



From guojie350@163.com Wed Nov 19 20:36:14 2008
X-Original-To: ******@*********
Delivered-To: ******@*********
To: ******@*********
Subject: =?ISO-2022-JP?B?GyRCIVobKEI0MBskQjpQMEo+ZUBsTVEhW0VUOWckTk5JJCQlUSE8GyhC?=
=?ISO-2022-JP?B?GyRCJUglSiE8JHIlOSVgITwlOiRLJDQ+UjJwQ1ckNyReJDkhIxsoQg==?=
Date: Wed, 19 Nov 2008 20:34:41 +0900
From: guojie350@163.com
X-Priority: 3
X-Mailer: Microsoft Outlook Express 6.00.2900.3138
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Content-Type: text/plain; charset="iso-2022-jp"

━-━-━-━-━-━-━-━-━-━-━-━-━-━-━-━-━-━-━-━
食事やお酒など一緒に楽しめる友人関係~一夜限り又は定期的に


テストデータ2(data_2.txt)



From guojie350@163.com Wed Nov 19 20:36:14 2008
X-Original-To: ******@*********
Delivered-To: ******@*********
To: ******@*********
Subject: =?ISO-2022-JP?B?GyRCIVobKEI0MBskQjpQMEo+ZUBsTVEhW0VUOWckTk5JJCQlUSE8GyhC?=
=?ISO-2022-JP?B?GyRCJUglSiE8JHIlOSVgITwlOiRLJDQ+UjJwQ1ckNyReJDkhIxsoQg==?=
Date: Wed, 19 Nov 2008 20:34:41 +0900
From: SPAMMER GUY <guojie350@163.com>
X-Priority: 3
X-Mailer: Microsoft Outlook Express 6.00.2900.3138
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Content-Type: text/plain; charset="iso-2022-jp"

━-━-━-━-━-━-━-━-━-━-━-━-━-━-━-━-━-━-━-━
食事やお酒など一緒に楽しめる友人関係~一夜限り又は定期的に


テストデータ3(data_3.txt)



From guojie350@163.com Wed Nov 19 20:36:14 2008
X-Original-To: ******@*********
Delivered-To: ******@*********
To: ******@*********
Subject: =?ISO-2022-JP?B?GyRCIVobKEI0MBskQjpQMEo+ZUBsTVEhW0VUOWckTk5JJCQlUSE8GyhC?=
=?ISO-2022-JP?B?GyRCJUglSiE8JHIlOSVgITwlOiRLJDQ+UjJwQ1ckNyReJDkhIxsoQg==?=
Date: Wed, 19 Nov 2008 20:34:41 +0900
From: <guojie350@163.com>
X-Priority: 3
X-Mailer: Microsoft Outlook Express 6.00.2900.3138
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Content-Type: text/plain; charset="iso-2022-jp"

━-━-━-━-━-━-━-━-━-━-━-━-━-━-━-━-━-━-━-━
食事やお酒など一緒に楽しめる友人関係~一夜限り又は定期的に


上記3パターンのデータを実証用コードに食わせて、その出力をそれぞれ見てみると、以下のような結果となります。

結果



[yt@air Email-Filter]$ cat data_1.txt | ./test.pl
$VAR1 = 'guojie350@163.com';
[yt@air Email-Filter]$ cat data_2.txt | ./test.pl
$VAR1 = 'Spammer Guy <guojie350@163.com>';
[yt@air Email-Filter]$ cat data_3.txt | ./test.pl
$VAR1 = '<guojie350@163.com>';


上記より、[Perl]Email::FilterとかEmail::Simpleでheaderメソッド使ってFromを取得するときの注意でオイラが書いた内容は嘘っぱちであることが証明されましたorz

ごめんなさいごめんなさいごめんなさい><

[生活]謹賀新年

本年も、皆様の健康とご盛栄をお祈り申し上げます。



平成21年 元旦 ytnobody