FieldHashを使ったInside-Outクラスあれこれ - Islands in the byte stream (legacy)

Hash::Util::FieldHashを使うとInside-Outクラスを簡単に作ることができる。といっても，これはクラスビルダーではないのであくまでも「何も使わずにクラスを書くのと同じくらい簡単に」という程度でしかないが。

# Book.pm
package Book;
use strict;
use Hash::Util::FieldHash qw(fieldhashes);
fieldhashes \my(%title_of, %author_of);
sub new{
  my($class, $title, $author) = @_;
  my $self = bless {}, $class;
  $title_of{$self}  = $title;
  $author_of{$self} = $author;
  return $self;
}
sub title{
  my $self = shift;
  return @_ ? ($title_of{$self} = shift) : $title_of{$self};
}
sub author{
  my $self = shift;
  return @_ ? ($author_of{$self} = shift) : $author_of{$self};
}
1;
__END__

この$title_of{$self}に保存した値は，$selfが開放されると同時に自動的に開放される。このようなInside-Outフィールドの管理を手動で行うのは大変だが，CPANにはこのようなフィールドの管理を行うモジュールが既に複数ある。Class::Std, Class::InsideOut, Object::InsideOut, MooseX::InsideOutなどがそうである。それらの中では，H::U::FieldHashはもっとも低レベルなAPIを提供しているモジュールであるといえる。
このクラスは以下のように普通のクラスとまったく同様に使用できる。

#!perl -w
# script.pl
use strict;
use Book;
my $book = Book->new('Programming Perl', 'Larry Wall');
print $book->title, ' ', $book->author, "\n";
__END__

『Perl ベストプラクティス』では，Inside-Outクラスを奨励している。Inside-Outクラスのオブジェクトの中身は外からは見えず，安全だというのがその理由である。しかし，これは普通のハッシュリファレンスによるオブジェクトより遅い。
そこで，Hash::Util::FieldHashを再実装してみた: http://search.cpan.org/dist/Hash-FieldHash/
H::U::FieldHashのAPIは煩雑なので，最もよく使うであろうfieldhash()/fieldhashes()のみ提供し，5.10以前にも対応している。Magicを駆使しているため，Pure Perlによる実装はできなかった*1。

ベンチマーク：

$ perl5.10.0 -Mblib benchmark/mouse.pl
new, and access(read:write 2:4)*100
Benchmark: running H::F, H::U::F, Mouse for at least 1 CPU seconds...
      H::F:  1 wallclock secs ( 1.07 usr +  0.00 sys =  1.07 CPU) @ 1046.73/s (n=1120)
   H::U::F:  1 wallclock secs ( 1.09 usr +  0.00 sys =  1.09 CPU) @ 822.02/s (n=896)
     Mouse:  1 wallclock secs ( 1.08 usr +  0.00 sys =  1.08 CPU) @ 1243.52/s (n=1343)
          Rate H::U::F    H::F   Mouse
H::U::F  822/s      --    -21%    -34%
H::F    1047/s     27%      --    -16%
Mouse   1244/s     51%     19%      --
access(read:write 2:4)*100
Benchmark: running H::F, H::U::F, Mouse for at least 1 CPU seconds...
      H::F:  1 wallclock secs ( 1.06 usr +  0.00 sys =  1.06 CPU) @ 1055.66/s (n=1119)
   H::U::F:  1 wallclock secs ( 1.05 usr +  0.00 sys =  1.05 CPU) @ 853.33/s (n=896)
     Mouse:  1 wallclock secs ( 1.06 usr +  0.00 sys =  1.06 CPU) @ 1267.92/s (n=1344)
          Rate H::U::F    H::F   Mouse
H::U::F  853/s      --    -19%    -33%
H::F    1056/s     24%      --    -17%
Mouse   1268/s     49%     20%      --

H::U::FieldHashよりは20%速いが，Mouseと比較すると20%遅い。残念。

ベンチマークスクリプト(Hash-FieldHash/benchmark/mouse.pl):

#!perl -w
use strict;
use Benchmark qw(:all);

BEGIN{
  package M;
  use Mouse;

  has foo => (
    is => 'rw',
  );
  has bar => (
    is => 'rw',
  );
  has baz => (
    is => 'rw',
  );
  __PACKAGE__->meta->make_immutable;
}
BEGIN{
  package HF;
  use Hash::FieldHash qw(:all);
  fieldhashes \my(%foo, %bar, %baz);

  sub new{ bless {}, shift }

  sub foo{
    my $self = shift;
    @_ ? ($foo{$self} = shift) : $foo{$self}
  }
  sub bar{
    my $self = shift;
    @_ ? ($bar{$self} = shift) : $bar{$self}
  }
  sub baz{
    my $self = shift;
    @_ ? ($baz{$self} = shift) : $baz{$self}
  }
}
BEGIN{
  package HUF;
  use Hash::Util::FieldHash::Compat qw(:all);
  fieldhashes \my(%foo, %bar, %baz);

  sub new{ bless {}, shift }

  sub foo{
    my $self = shift;
    @_ ? ($foo{$self} = shift) : $foo{$self}
  }
  sub bar{
    my $self = shift;
    @_ ? ($bar{$self} = shift) : $bar{$self}
  }
  sub baz{
    my $self = shift;
    @_ ? ($baz{$self} = shift) : $baz{$self}
  }
}

print "new, and access(read:write 2:4)*100\n";
cmpthese timethese -1 => {
  'H::F' => sub{
    my $o = HF->new();
    for(1 .. 100){
      $o->foo($_);
      $o->bar($o->foo + $o->foo + $o->foo + $o->foo);
    }
  },
  'H::U::F' => sub{
    my $o = HUF->new();
    for(1 .. 100){
      $o->foo($_);
      $o->bar($o->foo + $o->foo + $o->foo + $o->foo);
    }
  },
  'Mouse' => sub{
    my $o = M->new();
    for(1 .. 100){
      $o->foo($_);
      $o->bar($o->foo + $o->foo + $o->foo + $o->foo);
    }
  },
};

my $hf  = HF->new();
my $huf = HUF->new();
my $m   = M->new();
print "access(read:write 2:4)*100\n";
cmpthese timethese -1 => {
  'H::F' => sub{
    for(1 .. 100){
      $hf->foo($_);
      $hf->bar($hf->foo + $hf->foo + $hf->foo + $hf->foo);
    }
  },
  'H::U::F' => sub{
    for(1 .. 100){
      $huf->foo($_);
      $huf->bar($huf->foo + $huf->foo + $huf->foo + $huf->foo);
    }
  },
  'Mouse' => sub{
    for(1 .. 100){
      $m->foo($_);
      $m->bar($m->foo + $m->foo + $m->foo + $m->foo);
    }
  },
};
__END__

*1:5.8でも使用できるHash::Util::FieldHash::CompatもVariable::Magicを使っているのでPure Perlではない。