しんぐるとーん。

さて、リファクタリングをしよう！って事は

つまり、コードが余計な事してて遅いって訳なんで、

そのボトルネックを調査してたんですが。

懲りすぎたOOP&perl故に、トリッキー過ぎて

いちいち何処のコードが呼ばれているのか

探すのが難しい状況だったのでした。

で、普通はそこで Apache::DProf やら Devel::DProf で

ガガーっとトレースすればわかるもんなんだけど、

ここのコードは、前述のようにあまりに懲りすぎてるもんだからか

トレースかけても、全部おっかけてくれない。

おーまいがーっ

一体何が起きてるんだよ…orz

ちなみに、存在しないクラスのメソッドを叩かれたら

AUTOLOAD を使って、別のクラスのメソッドを起動するような仕組みになってたんで

その辺りではぐれてるのかなー…なんて思ったりしてますが。

そんな訳で仕方なく、とりあえず Class::DBI を使ってる部分を軽量化する方向で

高速化するよう検討・実装しつつあったので、DBIを使ってO/Rマッパーっぽい

軽量化したスーパークラスを作ってたんだけど。

いや、勿論本当は DBIx::Class とか使えばいいんだろーけど

訳あって現状、サーバー構成が確実には見えてないので、

cpanモジュールのインストールしそびれサーバーとか出てくる可能性があったりなんかして。

かくして、cpan は頼らずに、直接コードに書いてまえー…とやってみた結果、

ベンチ取ったら4倍速くなったんで、ニコニコしてたらば。

実は、それ以上に激しくボトルネックになっている箇所を

ここ2日ばかしで発見して、どうにか解消出来ないか検討してたのでした。

で、詳しい状況はあまりに特殊過ぎて書ききれないので省略するとして、

簡単に言うと、あらゆるクラスを new し過ぎているので

シングルトンで対処しようと思ったのですがー。

って言っても凝った事出来ない＆これ以上混乱したコードにしたくないので（笑）

new 実行時に bless したオブジェクトを

メンバ変数 _instance に格納しといて、再利用する程度なんですが。

package Hoge;
sub new {
   my $self = shift;
   return $self->{'_instance'} if defined $self->{'_instance'};

   $self->{'_instance'} = bless {}, $self;
   return $self->{'_instance'};
}
1;

その new しているタイミングが、

コントローラーで new されたクラスのメソッドから呼ばれたクラスの中で、

引き数にあった文字列を参照して use xxx; new xxx; しているので、

この _instance が、何処まで生き続けてくれるのかしら？って心配になったのでした。

…って、あまりにも複雑な構造なんで、あまり良く説明出来てないな…ごめん。

なにはともあれ、そんな心配を解消する為にテスト。

・A.pm

package A;
sub new { bless {}, $_[0]; }

sub start {
        my $self        = shift;
        my $name     = shift;

        my $obj         = $self->get($name);
        $obj->set();

        $self->add($obj);
}

sub get {
        my $self        = shift;
        my $name     = shift;

        eval "use ${name}";
        eval { ${name}->new(); }; # これが何度も実行されて new している箇所
}

sub add {
        my $self        = shift;
        my $obj         = shift;

        push @{$self->{'_hoge'}}, $obj;
}
1;

・B.pm

package B;
use Time::HiRes qw(gettimeofday);

sub new {
        my $self = shift;
        return $self->{'_instance'} if defined $self->{'_instance'};

        $self->{'_instance'} = bless {'time' => (gettimeofday)[0]}, $self;
        return $self->{'_instance'};

}

1;

・B::A.pm

package B::A;
use base (B);
sub set { $_[0]->{'name'} = __PACKAGE__; }
1;

・B::B.pm

package B::B;
use base (B);
sub set { $_[0]->{'name'} = __PACKAGE__; }
1;

・B::C.pm

package B::C;
use base (B);
sub set { $_[0]->{'name'} = __PACKAGE__; }
1;

・test.pl

#!/usr/bin/perl -w

use strict;
use lib qw(/home/anigon/singleton);
use A;

&_test('B::A');
&_test('B::B');
&_test('B::C');

sub _test {
        my $name        = shift;

        my $obj         = new A;
        $obj->start($name) for (1..3);

        foreach my $hoge (@{$obj->{'_hoge'}}){
                print "-----------------------------\n";
                print "OBJ\t", $hoge, "\n";
                print "REF\t", ref $hoge, "\n";
                print "NAME\t", $hoge->{'name'},"\n";
                print "TIME\t", $hoge->{'time'},"\n";
        }
}
# end of this script

ほんで、この test.pl を実行すっと…


-----------------------------
OBJ     B::A=HASH(0x8ffcb28)
REF     B::A
NAME    B::A
TIME    1234469209
-----------------------------
OBJ     B::A=HASH(0x8ffcb28)
REF     B::A
NAME    B::A
TIME    1234469209
-----------------------------
OBJ     B::A=HASH(0x8ffcb28)
REF     B::A
NAME    B::A
TIME    1234469209
-----------------------------
OBJ     B::B=HASH(0x9089724)
REF     B::B
NAME    B::B
TIME    1234469210
-----------------------------
OBJ     B::B=HASH(0x9089724)
REF     B::B
NAME    B::B
TIME    1234469210
-----------------------------
OBJ     B::B=HASH(0x9089724)
REF     B::B
NAME    B::B
TIME    1234469210
-----------------------------
OBJ     B::C=HASH(0x9089934)
REF     B::C
NAME    B::C
TIME    1234469210
-----------------------------
OBJ     B::C=HASH(0x9089934)
REF     B::C
NAME    B::C
TIME    1234469210
-----------------------------
OBJ     B::C=HASH(0x9089934)
REF     B::C
NAME    B::C
TIME    1234469210

…とそれぞれの継承クラス毎で HASH=(xxx)の参照先のアドレスが同じで、

ちゃんと継承クラスで実行した name の値も挿入されている事が確認されたのでした。

うーん、これなら大丈夫かもなー。

工数の都合やリスクを検討しつつ、月曜日に実装して計測してみよっと。

frei

旧「anney's room」からブログ「frei」だけ引っ越し＆残しました

しんぐるとーん。