由内而外的 Perl 深度克隆 类 - 如何使用复制对象的方法?

Deep cloning of inside-out Perl classes - how to use methods from copied objects?

我有 3 个 类 使用 Class::Std 声明为 inside-out Perl 类。在这 3 个中的一个中,$basket{ident $self} 中存储了一个哈希引用,看起来像这样(Data::Dumper 的输出):

$VAR1 = {
          'auto' => {
                      'items' => {
                                   'abc' => bless( do{\(my $o = undef)}, 'Item' )
                                 },
                      'obj' => bless( do{\(my $o = undef)}, 'Category' )
                    }
        };

我需要获取此哈希引用并再次创建其中的所有内容(深度克隆)。我尝试像这样使用 Storable 中的 dclone

my $new_basket = dclone $basket{ident $self};

当我打印散列时,我得到了不同的内存地址:

print $new_basket, "\n";
print $basket{ident $self}, "\n";
print $new_basket->{auto}->{items}, "\n";
print $basket{ident $self}{auto}->{items}, "\n";
print $new_basket->{auto}->{items}->{abc}, "\n";
print $basket{ident $self}{auto}->{items}->{abc}, "\n";

这将输出:

HASH(0x55d325306a20)
HASH(0x55d325245298)
HASH(0x55d323b35ca8)
HASH(0x55d3243dd968)
Item=SCALAR(0x55d323b45190)
Item=SCALAR(0x55d325306588)

当我不使用 dclone 而是使用 my $new_basket = $basket{ident $self} 时,我得到相同的内存地址。当我使用my $new_basket = { %{ $basket{ident $self} } }时,我只在第一层得到不同的地址,这应该是一个浅拷贝。这一切似乎都很好,也在意料之中。

所以,在我看来 dclone 实际上是深度复制了所有内容,因为地址不同。但是当我尝试在 Item 中使用方法时,如下所示:

print $new_basket->{auto}->{items}->{abc}->get_added_on();
print $basket{ident $self}{auto}->{items}->{abc}->get_added_on();

我得到:

Use of uninitialized value in print at lib/Basket.pm line 231.
2020-05-30

很明显,dclone 的工作方式与我天真的想法不同。

我应该如何深度复制整个结构? 我希望得到一些帮助或参考一些 article/doc 我可以阅读这里发生的事情。

一个解决方案是使用构造函数再次创建整个结构,但我想我会节省一些 space 并使用 dclone。显然结果不是很好。

编辑: 我被要求提供一个最小的可运行演示,这里是:

#!/usr/bin/env perl

use strict;
use warnings;

{
    package A;
    use Class::Std;
    use Data::Dumper;
    use Storable qw(dclone);

    my %basket :ATTR;

    sub BUILD {
        my ($self, $ident, $args_ref) = @_;
        $basket{$ident}->{auto} = {};

        my $c = C->new({ date => q{2020-05-30} }); 

        $basket{$ident}->{auto}->{items}->{abc} = $c;      

        return;
    }

    sub deep_clone {
        my $self = shift;

        print Dumper $basket{ident $self};
        # the next line prints "2020-05-30" as expected
        print $basket{ident $self}->{auto}->{items}->{abc}->get_added_on();
        my $new_basket = dclone $basket{ident $self};
        # "Use of uninitialized value in print at ./deep-clone.pl line 35."
        print $new_basket->{auto}->{items}->{abc}->get_added_on();
    }
}

{
    package C;
    use Class::Std;

    my %added_on :ATTR( :get<added_on> );

    sub BUILD {
        my ($self, $ident, $args_ref) = @_;

        $added_on{$ident} = $args_ref->{date};

        return;
    }
}

####

my $a = A->new();
$a->deep_clone();

新创建的 "C" 对象从未添加到 %added_on

您的 类 将必须为 Storable 提供自定义处理程序来处理它们。

添加到 "A":

sub STORABLE_freeze {
    my ($self, $cloning) = @_;
    my $ident = ident($self);
    return "", {
        basket => $basket{$ident},
        # Other attributes...
    };
}

sub STORABLE_thaw {
    my ($self, $cloning, $serialized, $inner) = @_;
    my $ident = ident($self);
    $basket{$ident} = $inner->{basket};
    # Other attributes...
}

添加到 "C":

sub STORABLE_freeze {
    my ($self, $cloning) = @_;
    my $ident = ident($self);
    return "", {
        added_on => $added_on{$ident},
        # Other attributes...
    };
}

sub STORABLE_thaw {
    my ($self, $cloning, $serialized, $inner) = @_;
    my $ident = ident($self);
    $added_on{$ident} = $inner->{added_on};
    # Other attributes...
}

那你就可以正常使用freeze/thaw/dclone

sub deep_clone {
    my $self = shift;

    #print Dumper $basket{ident $self};
    CORE::say $basket{ ident $self  }{auto}{items}{abc}->get_added_on();

    my $clone = dclone($self);

    #print Dumper $basket{ident $self};
    CORE::say $basket{ ident $clone }{auto}{items}{abc}->get_added_on();
}