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はオブジェクトを再帰的に全部コピーしてくれます。
コードで書くならこうですね。
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が生成されています。
Mouse::Meta::ClassにはいくつかMouseオブジェクトのmeta情報を取り出すことができるメソッドの中で、clone_objectでDeep Copyすることができます。
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にあります。
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が増えたときにも対応できて便利なように見えますが、メタプログラミング的な拡張記法になってしまうためもしかしたら意図しない挙動をするかもしれません。
この記事を書くに至った事の発端は、テストでmockしたメソッドのreturnのオブジェクトをメソッドの適用前後で比較しようとして、違いを期待しているのに同じとテストが怒ったので調べてみたら「同じオブジェクトじゃーん（変更前のオブジェクトが残ってない）」となるミスをやらかしです。 そういえばそうですねという自戒の念で書きました。
