Here's a base class for generating flattened accessors for nested hash structs:
package Class::StructAccessors;
use warnings; use strict;
use Scalar::Util qw/reftype/;
sub mk_struct_accessors {
my ($class, $struct, $path, $key_seen, $ref_seen) = @_;
$path ||= [];
$key_seen ||= {};
$ref_seen ||= {};
while (my ($k,$v) = each %$struct) {
my $reftype = reftype($v)||'';
if ($reftype) {
die "Bad reference type: $reftype"
unless ($reftype eq 'HASH');
die "Cycle detected at $v"
if ($ref_seen->{$v});
$ref_seen->{$v} = 1;
$class->mk_struct_accessors($v, [@$path, $k], $key_seen, $
+ref_seen);
}
else {
die "null key" unless (defined $v && $v ne '');
die "Duplicate key detected $v"
if ($key_seen->{$v});
$key_seen->{$v} = 1;
#
# add this accessor to the class
#
no strict 'refs';
warn "adding: $v";
*$v = sub {
my $self = shift;
return $self->_dereference(@$path, $k, $v);
}
}
}
}
sub _dereference {
my $self = shift;
my @hash_keys = @_;
my $ref = $self;
while (@hash_keys && $ref) {
$ref = $ref->{shift(@hash_keys)};
}
return $ref;
}
1;
It dies if the struct contains any duplicate keys or cycles.
A test script follows:
package Foo;
use base qw{Class::StructAccessors};
__PACKAGE__->mk_struct_accessors({
A => {
B => 'C'
},
D => {
E => {
F => 'G'
}
},
## Z => 'G', # Duplicate test
## X => [1,2,3], # Bad type test
## N => do {my $cycle = {}; $cycle->{M} = $cycle; $cycle;}, # Cyclic
+ test
});
package main;
use Foo;
my $obj = bless {
A => {
B => {'C' => "It's hello from C"},
},
D => {
E => {
F => {'G' => "G'day from G"}
}
}
}, 'Foo';
print "C:".$obj->C."\n";
print "G:".$obj->G."\n";
Update: Added test for cycles.
|