«Подключение» объекта Moo с хешем

Question

В моем реальном коде я хочу «синхронизировать» объект Moo (или Moose if Moo не работает) с хешем (на самом деле связанным хэшем), так что чтение свойство объекта Moo будет считывать соответствующее значение из хэша и записывать свойство объекта Moo, которое будет храниться в хеше.

Ниже приведен упрощенный код:

#!/usr/bin/perl 

use feature qw(say); 

package X; 
use Moo; 
use Data::Dumper; 

my $BusinessClass = 'X'; 

has 'base' => (is => 'rw', builder => 'base_builder'); 

sub base_builder { 
    return {}; 
} 

foreach my $Key (qw(a b c)) { 
    { 
    no strict 'refs'; 
    *{"${BusinessClass}::$Key"} = sub { 
     if (@_ == 2) { 
     return $_[0]->base->{$Key} = $_[1]; 
     } else { 
     return $_[0]->base->{$Key}; 
     } 
    }; 
    has $Key => (is  => 'rw', 
        lazy  => 0, 
        required => 0, 
        reader => "${BusinessClass}::_access1_$Key", 
        writer => "${BusinessClass}::_access2_$Key", 
       ); 
    } 
} 

my $obj = X->new(a=>123, b=>456); 
print Dumper $obj->base; 
$obj->c(789); 
print Dumper $obj->base; 

Беда в том, что атрибуты, передаваемые new функции не сохраняются в $obj->base имеет (но они должны быть). В приведенном выше примере кода атрибут c правильно хранится как следует, но a и b не сохраняются в хеш. Это ошибка.

Каковы хорошие способы решения этой проблемы?

Answer 1

Это может быть решена путем добавления:

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

    foreach my $Key (keys %$args) { 
    $self->base->{$Key} = $args->{$Key}; 
    my $clearer = "_clear_local_$Key"; 
    $self->$clearer(); 
    } 
} 

Полный код:

#!/usr/bin/perl 

use feature qw(say); 

package X; 
use Moo; 
use Data::Dumper; 

my $BusinessClass = 'X'; 

has 'base' => (is => 'rw', builder => 'base_builder'); 

sub base_builder { 
    return {}; 
} 

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

    foreach my $Key (keys %$args) { 
    $self->base->{$Key} = $args->{$Key}; 
    my $clearer = "_clear_local_$Key"; 
    $self->$clearer(); 
    } 
} 

foreach my $Key (qw(a b c)) { 
    { 
    no strict 'refs'; 
    *{"${BusinessClass}::$Key"} = sub { 
     if (@_ == 2) { 
     return $_[0]->base->{$Key} = $_[1]; 
     } else { 
     return $_[0]->base->{$Key}; 
     } 
    }; 
    has $Key => (is  => 'rw', 
        lazy  => 0, 
        required => 0, 
        reader => "${BusinessClass}::_access1_$Key", 
        writer => "${BusinessClass}::_access2_$Key", 
        clearer => "_clear_local_$Key", 
       ); 
    } 
} 

my $obj = X->new(a=>123, b=>456); 
print Dumper $obj->base; 
$obj->c(789); 
print Dumper $obj->base; 

print Dumper {%$obj};