インスタンスが属するクラスをあとから変更する操作を Perl で


どうにも苦手な Perl の勉強をかねて。

Perl のオブジェクトは「blessed reference」で、かつ、bless しなおせば新しいクラス(パッケージ)に属させることは可能なので、クラスを変更できない Ruby のような困難は特にはなさそうですね。あとは Ruby 同様に、オブジェクトの実体であるハッシュの中身を書き換えてやれば別のクラスのインスタンスにも化け切れるはずで、たしかにそのようになりました。

use strict;
use warnings;
use Math::Trig;

package Cartesian;

sub new {
  my $class = shift;
  my $self = { x => $_[0], y => $_[1] };
  return bless $self, $class
}

sub new_from {
  my($class, $polar) = @_;
  my($r, $theta) = ($polar->{r}, $polar->{theta});
  return $class->new($r*cos($theta), $r*sin($theta));
}

package Polar;

sub new {
  my $class = shift;
  my $self = { r => $_[0], theta => $_[1] };
  return bless $self, $class
}

sub new_from {
  my($class, $cart) = @_;
  my($x, $y) = ($cart->{x}, $cart->{y});
  return $class->new(sqrt($x*$x + $y*$y), atan2($y, $x));
}

package main;

sub transmogrify {
  my($a, $b) = @_;
  undef %$a;
  while ( my($key, $val) = each %$b ) { $a->{$key} = $val; }
  bless $a, ref $b
}

my $pos1 = new Polar(sqrt(2), pi/4);
my $pos2 = $pos1;
print ref $pos1, "\n";    #=> Polar

transmogrify($pos1, Cartesian->new_from($pos1));
print ref $pos1, "\n";    #=> Cartesian
print $pos1->{x}, "\n";   #=> 1
print $pos1->{y}, "\n";   #=> 1
print ref $pos2, "\n";    #=> Cartesian

transmogrify($pos1, Polar->new_from($pos1));
print ref $pos1, "\n";    #=> Polar
print $pos1->{r}, "\n";   #=> 1.4142135623731
print $pos1->{theta}/pi, "\n";  #=> 0.25
print ref $pos2, "\n";    #=> Polar