UNIVERSAL::whichで取得できるメソッド名が違うケース

UNIVERSAL::which、便利なんでちょいちょい使ってるんですが、ちょっと微妙なケースが。

こういう場合。

 package Foo;
 sub hoge {}

 package Bar;
 *muge = \&Foo::hoge;

 use UNIVERSAL::which;
 print scalar Bar->which('muge');

これを実行すると

 Foo::muge

と表示されるわけです。

見ればわかると思いますが、Fooにmugeなんてメソッドは存在しないわけでして。

なんでこんなことになっちゃうかというとwhichの引数で渡された値をそのまま使ってるのが問題なんですね。

同じ理由で下記のようなコードも

 package Foo;
 my $code = sub {};

 package Bar;
 *muge = $code;

 use UNIVERSAL::which;
 print scalar Bar->which('muge');

Foo::mugeになっちゃうわけです。この場合はFoo::__ANON__になったほうが望ましいと思うのですが。

というわけでコードリファレンスから動的に関数名を取得するようにすれば問題解決かと。

以下パッチ

 --- which.pm    Mon May 15 16:47:59 2006
 +++ which_patch.pm      Thu Apr 12 15:23:06 2007
 @@ -13,8 +13,10 @@
      }
      return unless $coderef;
      require B;
 -    my $pkg =  B::svref_2object($coderef)->GV->STASH->NAME;
 -    return wantarray ? ($pkg, $method) : $pkg . '::' . $method;
 +    my $gv = B::svref_2object($coderef)->GV;
 +    my $method_name = $gv->NAME;
 +    my $pkg         = $gv->STASH->NAME;
 +    return wantarray ? ($pkg, $method_name) : $pkg . '::' . $method_name;
  }

Bモジュールあんまり使ったことないので使い方あってるかどうかちょっと不安ですがこうすれば先ほどの例も

 package Foo;
 sub hoge {}

 package Bar;
 *muge = \&Foo::hoge;

 use UNIVERSAL::which;
 print scalar Bar->which('muge'); # Foo::hoge

とちゃんと表示されるようになりました。

ちなみにもうひとつ問題があってですね、これはUNIVERSAL::whichが悪いわけじゃないんですが、下記のような例

 package Foo; 
 use base qw/Class::Data::Inheritable/;
 __PACKAGE__->mk_classdata('hoge');
 
 use UNIVERSAL::which;
 print scalar Foo->which('hoge');

コレを実行すると

 Class::Data::Inheritable::hoge
 # ちなみにパッチ済みの場合は Class::Data::Inheritable::__ANON__ になる

ぎゃあですなコレ。

いやまぁ確かにClass::Data::Inheritableで定義されたものではあるけどもメソッドを探してるときにwhich使ってコレが出てきたらちょっとへこみますよね。結局どこで定義されてるのかわからん!みたいな。

ここは無理を言えばFoo::hogeになって欲しいところですが例外を作ってたらキリがないのでさすがにどうしようもないですね・・・。

こういうケースではClass::Data::Inheritable使ってるモジュールをgrep等で検索するしかないですかね。