In my real code I want to "synchronize" a Moo (or Moose if Moo won't work) object with a hash (in reality a tied hash), so that reading a property of the Moo object would read the corresponding value from the hash and writing a property of the Moo object would store into the hash.
The following is a simplified code:
#!/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;
The trouble is that attributes passed to new
function are not stored in the has $obj->base
(but they should be). In the above code example the attribute c
is properly stored as it should, but a
and b
are not stored into the hash. This is a bug.
What are good ways to handle this situation?
This can be solved by adding:
sub BUILD {
my ($self, $args) = @_;
foreach my $Key (keys %$args) {
$self->base->{$Key} = $args->{$Key};
my $clearer = "_clear_local_$Key";
$self->$clearer();
}
}
Complete code:
#!/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};