Perl内向外类深度克隆：如何调用复制对象的方法？

问题根源 #

你遇到的报错本质是Class::Std的内向外类（inside-out classes）和Storable的dclone工作逻辑不匹配：

Class::Std实现的内向外类，对象本身只是一个被bless的空标量（或者undef），所有属性都存在包级的独立哈希里（比如C类中的%added_on），通过ident $self返回的唯一ID作为哈希键来绑定对象和属性。

而Storable的dclone默认只会克隆那个被bless的空标量外壳，完全不会触碰Class::Std用来存储属性的包级哈希。所以克隆后的C对象看起来和原对象结构一致，但在%added_on里找不到对应的ID键，调用get_added_on自然就返回undef了。

解决方案1：给内向外类添加自定义clone方法 #

最直接的方式是为每个需要克隆的内向外类手动实现clone方法，然后递归遍历哈希，遇到对象时调用其clone方法完成深度复制：

#!/usr/bin/env perl
use strict;
use warnings;
use Scalar::Util qw(blessed);

{
    package A;
    use Class::Std;

    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;
    }

    sub deep_clone {
        my $self = shift;
        my $original = $basket{ident $self};
        
        # 递归克隆哈希，处理对象
        my $new_basket = _recursive_clone($original);
        
        # 测试克隆后的方法调用
        print $new_basket->{auto}->{items}->{abc}->get_added_on(), "\n"; # 输出2020-05-30
    }

    # 自定义递归克隆函数
    sub _recursive_clone {
        my ($item) = @_;
        if (ref $item eq 'HASH') {
            my %cloned;
            while (my ($k, $v) = each %$item) {
                $cloned{$k} = _recursive_clone($v);
            }
            return \%cloned;
        } elsif (blessed $item && $item->can('clone')) {
            return $item->clone();
        }
        # 简单类型直接返回
        return $item;
    }
}

{
    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};
    }

    # 实现自定义clone方法
    sub clone {
        my ($self) = @_;
        return __PACKAGE__->new({
            date => $self->get_added_on(),
        });
    }
}

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

解决方案2：利用Storable的序列化钩子 #

Storable提供了STORABLE_freeze和STORABLE_thaw钩子方法，让类可以自定义序列化/反序列化逻辑。我们可以给C类添加这两个方法，让dclone能正确保存和恢复属性：

{
    package C;
    use Class::Std;
    use Scalar::Util qw(ident);

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

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

    # 序列化时保存属性数据
    sub STORABLE_freeze {
        my ($self, $is_cloning) = @_;
        # 返回序列化的数据，这里我们保存date属性
        return (undef, { date => $self->get_added_on() });
    }

    # 反序列化时恢复属性
    sub STORABLE_thaw {
        my ($self, $is_cloning, $serialized_data) = @_;
        my $obj_id = ident $self;
        $added_on{$obj_id} = $serialized_data->{date};
    }
}

添加钩子后，你原来的deep_clone方法可以直接用dclone，Storable会自动调用钩子处理对象的属性：

sub deep_clone {
    my $self = shift;
    my $original = $basket{ident $self};
    my $new_basket = dclone $original;
    print $new_basket->{auto}->{items}->{abc}->get_added_on(), "\n"; # 正常输出
}

关键原理总结 #

1. 内向外类特性：Class::Std通过包级哈希存储属性，对象本身只是无数据的bless标量，依赖ident $self的唯一ID关联属性。
2. Storable默认行为：dclone仅克隆对象的bless结构，不会处理类内部的属性存储哈希，因此需要自定义逻辑适配。

内容的提问来源于stack exchange，提问作者pavelsaman