in reply to Generating accessors and mutators for complex structures inside the object
It dies if the struct contains any duplicate keys or cycles.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;
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.
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re^2: Generating accessors for complex structures inside the object
by KSURi (Monk) on Jan 12, 2008 at 14:55 UTC | |
|
Re^2: Generating accessors for complex structures inside the object
by KSURi (Monk) on Jan 14, 2008 at 21:31 UTC | |
by snoopy (Curate) on Jan 15, 2008 at 22:33 UTC | |
by KSURi (Monk) on Jan 23, 2008 at 19:00 UTC |