Глубокое клонирование вывернутых наизнанку Perl классов - как использовать методы из скопированных объектов? - PullRequest
Новая
       37

Глубокое клонирование вывернутых наизнанку Perl классов - как использовать методы из скопированных объектов?

4 голосов
/ 30 мая 2020

У меня 3 класса объявлены как классы Perl наизнанку, используя Class::Std. В одном из этих 3 есть ссылка ha sh, хранящаяся в $basket{ident $self}, которая выглядит так (вывод Data :: Dumper): 

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

Мне нужно взять эту ссылку ha sh и заново создать все в нем (глубокое клонирование). Я пытался использовать dclone из Storable вот так: 

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 работает не так, как я наивно думал.

Как мне глубоко скопировать всю эту структуру? Я был бы признателен за некоторую помощь или ссылку на какую-нибудь статью / сделайте c, где я могу прочитать, что здесь происходит.

Одно из решений - снова создать всю структуру с помощью конструкторов, но я решил сэкономить место и использовать dclone. Это явно не получилось.

EDIT: Меня попросили предоставить минимальную работоспособную демонстрацию, вот она: 

#!/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();

1 Ответ

2 голосов
/ 31 мая 2020

Вновь созданный объект «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();
}
...