型グロブとシンボリックリファレンスでメソッド定義するときの注意点

型グロブとシンボリックリファレンスを使ってメソッドを動的に定義するというケースって結構あります。

例えばアクセサメソッドを提供するmk_accessorというのを作りたいとします。

 package Hoge;
 use strict;
 
 sub mk_accessor {
     my $class    = shift;
     my $accessor = shift;
     no strict 'refs';
     *{"${class}::$accessor"} = sub {
         my $self = shift;
         $self->{$accessor} = shift if @_;
         return $self->{$accessor};
     };
 }
 
 sub new {
     my $class = shift;
     return bless {} , ref $class || $class;
 }
 
 Hoge->mk_accessor('hoge_accessor');
 
 my $hoge = Hoge->new;
 $hoge->hoge_accessor(8);
 print $hoge->hoge_accessor; # 「8」

こんな感じですよね。
ですが、このmk_accessorメソッドは非常にマズイ実装になっています。
何故かって言うと、

 Hoge->hoge_accessor(8);
 print Hoge->hoge_accessor; # 「8」

という風にオブジェクトメソッドじゃなく、パッケージメソッド呼び出ししてもうまく動いてしまうんです。

何故か?

それはstrictの有効範囲が''レキシカルスコープ''ということに起因します。

つまり、「no strict 'refs'」の効果はレキシカルに行われるので、

 use strict;                               # <- strict 効いてる
 sub mk_accessor {                         # <- strict 効いてる
     my $class    = shift;                 # <- strict 効いてる
     my $accessor = shift;                 # <- strict 効いてる
     no strict 'refs';                     # <- strict refs 無効
     *{"${class}::$accessor"} = sub {      # <- strict refs 無効
         my $self = shift;                 # <- strict refs 無効
         $self->{$accessor} = shift if @_; # <- strict refs 無効
         return $self->{$accessor};        # <- strict refs 無効
     };                                    # <- strict refs 無効
 }                                         # <- strict 効いてる

っていうことになってしまいます。
つまり、strictってやつは、なんか「クロージャ(変数の有効範囲が消えてもどこからか参照されてれば変数が消えない)」みたいな動きをしているわけですね。

そして結果的にパッケージメソッドとして呼び出した場合に$selfにパッケージ名が格納され、内部的に、

 Hoge->{hoge} = 8;
 print Hoge->{hoge};

というように解釈されて、本来ならシンボリックリファレンス使用のエラーになるはずの処理が何事も無かったかのように動いてしまうわけです。

ちなみにHoge->{hoge}という処理はカレントパッケージの%Hogeに値を入れているのと同じ処理です。

 Hoge->{hoge} = 100;
 print $Hoge::Hoge{hoge}; # 「100」

これのせいで小一時間程ハマったことがあります。とほほ。

で、対策なんですが、no strict 'refs'の有効範囲を小さくしてやればOK。つまりクロージャ部分を囲まないようにするだけです。

 use strict;                               # <- strict 効いてる
 sub mk_accessor {                         # <- strict 効いてる
     my $class    = shift;                 # <- strict 効いてる
     my $accessor = shift;                 # <- strict 効いてる
     my $code     = sub {                  # <- strict 効いてる
         my $self = shift;                 # <- strict 効いてる
         $self->{$accessor} = shift if @_; # <- strict 効いてる
         return $self->{$accessor};        # <- strict 効いてる
     };                                    # <- strict 効いてる
     no strict 'refs';                     # <- strict refs 無効
     *{"${class}::$accessor"} = $code;     # <- strict refs 無効
 }                                         # <- strict 効いてる

上記のようにクロージャとなる部分を一旦$code変数に受け取り、no strict 'refs'の有効範囲を狭めます。

気をつけるべし。