Class::Data::Inheritable::DeepCopyってどうよ

昨日記事書いてて思い出したんだけどClass::Data::Inheritableってかなり良いモジュールですよね。でもリファレンスを保持する時にどうも使いにくいなーって思ってて例えば、

 package HOGE;
 use base qw( Class::Data::Inheritable );
 
 __PACKAGE__->mk_classdata('hoge',{ hoge => 10 });
 
 print HOGE->hoge->{hoge}; # 10

ハッシュのリファレンスをもつhogeっているクラスメソッドを作って
これを継承して下記のように書いた場合、

 
 package MUGE;
 use base qw( HOGE );
 
 MUGE->hoge->{hoge} = 20;
 
 print HOGE->hoge->{hoge}; # 20 になってしまう

参照しているリファレンスが同じためMUGEのやつを書き換えたらHOGEにも影響があるわけですね。なんで解決方法として、

 package MUGE;
 use base qw( HOGE );
 
 my $data = MUGE->hoge();
 MUGE->hoge( Clone::clone($data) );
 
 MUGE->hoge->{hoge} = 20;
 
 print HOGE->hoge->{hoge}; # 10 のまま

というように値をセットし直さないといけないのがびみょーだなーと。

と、いうわけでClass::Data::Inheritable::DeepCopyなんてものを考えてみました。

Class::Data::Inheritableとのdiffをば。

 
 --- Inheritable.pm        Sat Dec 24 11:41:42 2005
 +++ DeepCopy.pm Sat Dec 24 11:42:30 2005
 @@ -1,9 +1,11 @@
 -package Class::Data::Inheritable;
 +package Class::Data::Inheritable::DeepCopy;
 
  use strict qw(vars subs);
  use vars qw($VERSION);
  $VERSION = '0.04';
 
 +use Clone;
 +
  sub mk_classdata {
      my ($declaredclass, $attribute, $data) = @_;
 
 @@ -15,8 +17,8 @@
      my $accessor = sub {
          my $wantclass = ref($_[0]) || $_[0];
 
 -        return $wantclass->mk_classdata($attribute)->(@_)
 -          if @_>1 && $wantclass ne $declaredclass;
 +        return $wantclass->mk_classdata($attribute,Clone::clone($data))->(@_)
 +          if $wantclass ne $declaredclass;
 
          $data = $_[1] if @_>1;
          return $data;
 

んん。いいかも。