MouseでDeep Copy #perl - koluku's blog

Mouseのオブジェクトは変数で代入してコピーを作るとShallow Copy(値が複製されず元のオブジェクトへのレファレンスになる)されます。例えば、Mouseでモジュールを下のような作ったとします。

package Person;

use 5.32.0;
use warnings;
use utf8;

use Mouse;

has 'name' => (
    is  => 'rw',
    isa => 'Str',
);

has 'region' => (
    is  => 'rw',
    isa => 'Str',
);

no Mouse;

1;

これをmy $b = $a;のように変数を代入した後に、代入された変数に対してattributeを変更しようとすると代入した変数のattributeも変更されます。簡単に言えば、以下のテストが全部passします。

use 5.32.0;
use warnings;
use utf8;

use Test::More;

use Person;

subtest 'shallow copy' => sub {
    my $a = Person->new(
        {
            name   => 'koluku',
            region => 'Japan',
        }
    );
    my $b = $a;

    $b->name('koruku');

    is $a->name, $b->name;  # attributeの中身

    isnt \$a, \$b; # オブジェクトのアドレス
    is \$a->name,   \$b->name; # attributeのアドレス
    is \$a->region, \$b->region; # attributeのアドレス
};

done_testing;

$ prove -lrv t/person.t
t/person.t .. 
# Subtest: shallow copy
    ok 1
    ok 2
    ok 3
    ok 4
    1..4
ok 1 - shallow copy
1..1
ok
All tests successful.
Files=1, Tests=1,  0 wallclock secs ( 0.03 usr  0.01 sys +  0.08 cusr  0.02 csys =  0.14 CPU)
Result: PASS

$aも$bもそれ自体のアドレスは異なるものの、作られたattributeが元のオブジェクトのattributeのアドレスを参照しているため変更が共有されてしまいます。

完全に値をコピー（Deep Copy)するには2パターンほどあり、

Cloneモジュールを使う
Mouse::Meta::Class->clone_objectでコピーする

ででき、非推奨ですが、

(非推奨) Mouse::Meta::Class->get_attribute_listをmapでNewに代入する

という方法でも一応Deep Copyすることはできます。（非推奨の理由は後述）

Cloneモジュールを使う

たぶん最初に簡単に思いつくのはCloneモジュールでコピーしちゃうことだと思います。 Cloneはオブジェクトを再帰的に全部コピーしてくれます。

perldoc.jp

metacpan.org

コードで書くならこうですね。

use 5.32.0;
use warnings;
use utf8;

use Test::More;
use Clone qw(clone);

use Person;

subtest 'deep copy' => sub {
    my $a = Person->new(
        {
            name   => 'koluku',
            region => 'Japan',
        }
    );
    my $b = clone($a);

    $b->name('koruku');

    isnt $a->name, $b->name;

    isnt \$a, \$b;
    isnt \$a->name,   \$b->name;
    isnt \$a->region, \$b->region;
};

done_testing;

$ prove -lrv t/person.t
t/person.t .. 
# Subtest: deep copy
    ok 1
    ok 2
    ok 3
    ok 4
    1..4
ok 1 - deep copy
1..1
ok
All tests successful.
Files=1, Tests=1,  0 wallclock secs ( 0.04 usr  0.01 sys +  0.13 cusr  0.03 csys =  0.21 CPU)
Result: PASS

Mouse::Meta::Class->clone_objectでコピーする

先輩プログラマーに指摘されて気がついたのですが、Mouseには$obj->metaにMouse::Meta::Classが生成されています。

metacpan.org

Mouse::Meta::ClassにはいくつかMouseオブジェクトのmeta情報を取り出すことができるメソッドの中で、clone_objectでDeep Copyすることができます。

metacpan.org

use 5.32.0;
use warnings;
use utf8;

use Test::More;

use Person;

subtest 'deep copy' => sub {
    my $a = Person->new(
        {
            name   => 'koluku',
            region => 'Japan',
        }
    );
    my $b = $a->meta->clone_object($a);

    $b->name('koruku');

    isnt $a->name, $b->name;

    isnt \$a, \$b;
    isnt \$a->name,   \$b->name;
    isnt \$a->region, \$b->region;
};

done_testing;

$ prove -lrv t/person.t
t/person.t .. 
# Subtest: deep copy
    ok 1
    ok 2
    ok 3
    ok 4
    1..4
ok 1 - deep copy
1..1
ok
All tests successful.
Files=1, Tests=1,  0 wallclock secs ( 0.03 usr  0.01 sys +  0.08 cusr  0.02 csys =  0.14 CPU)
Result: PASS

ちなみに、clone_objectの実装はMouse::Meta::ClassではなくClass::MOP::Classにあります。

metacpan.org

https://metacpan.org/source/ETHER/Moose-2.2013/lib/Class/MOP/Class.pm#L763-795

(非推奨) Mouse::Meta::Class->get_attribute_listをmapでNewに代入する

これは非推奨なので見なくてもいいのですが、同じくMouse::Meta::Classにget_attribute_listメソッドがあり、これを使うことでそのオブジェクトが持っているattributeをすべて返してくれます。

Mouse::Meta::Class - The Mouse class metaclass - metacpan.org

これをmapでハッシュにしてコンストラクタに渡すと全く同じ値のオブジェクトが生成されます。

use 5.32.0;
use warnings;
use utf8;

use Test::More;

use Person;

subtest 'deep copy' => sub {
    my $a = Person->new(
        {
            name   => 'koluku',
            region => 'Japan',
        }
    );
    my $b = Person->new(
        (map { $_ = $a->$_ } $a->meta->get_attribute_list)
    );

    $b->name('koruku');

    isnt $a->name, $b->name;

    isnt \$a, \$b;
    isnt \$a->name,   \$b->name;
    isnt \$a->region, \$b->region;
};

done_testing;

$ prove -lrv t/person.t
t/person.t .. 
# Subtest: deep copy
    ok 1
    ok 2
    ok 3
    ok 4
    1..4
ok 1 - deep copy
1..1
ok
All tests successful.
Files=1, Tests=1,  0 wallclock secs ( 0.02 usr  0.01 sys +  0.08 cusr  0.02 csys =  0.13 CPU)
Result: PASS

直接attributeを指定して代入するよりかは手間も無くattributeが増えたときにも対応できて便利なように見えますが、メタプログラミング的な拡張記法になってしまうためもしかしたら意図しない挙動をするかもしれません。

ja.wikipedia.org

この記事を書くに至った事の発端は、テストでmockしたメソッドのreturnのオブジェクトをメソッドの適用前後で比較しようとして、違いを期待しているのに同じとテストが怒ったので調べてみたら「同じオブジェクトじゃーん（変更前のオブジェクトが残ってない）」となるミスをやらかしです。そういえばそうですねという自戒の念で書きました。