Re: Generating accessors for complex structures inside the object

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;
[download]

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";
[download]

Update: Added test for cycles.

Comment on Re: Generating accessors for complex structures inside the object Select or Download Code

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
Thanks! I'll try your code asap. Unfortunately I can't do this now =(	[reply]
Re^2: Generating accessors for complex structures inside the object by KSURi (Monk) on Jan 14, 2008 at 21:31 UTC
I've read your code attentively, now I want to ask a few questions please. Here: `... D => { E => { F => 'G' } }, ## Z => 'G', # Duplicate test ...` [download] If I'll uncomment 'Z' key there will be a warning thrown about duplicate 'G' key. But 'G' is not a key here, it's keys value. And here: `## X => [1,2,3], # Bad type test` [download] Why arrayref is a bad type? And the last one: I tried to add mutators to your code through assignment the lvalue attribute to _derefernce sub but it has no effect =( Any ideas of how can I do this?	[reply] [d/l] [select]
Re^3: Generating accessors for complex structures inside the object by snoopy (Curate) on Jan 15, 2008 at 22:33 UTC
Hi KSURi, Thanks for your questions. Before getting into the details; I did make some assumptions that need to be tested: The class level structure (defined in `Foo`) is a effectively a struct definition: So, if in Foo, you define `package Foo; use base qw/Class::StructAccessors/; __PACKAGE__->mk_struct_accessors({A => {B => C}});` [download] then the actual method created is `C`. `my $obj = {}; bless $obj, "Foo"; $obj->{A}{B}{C} = "this is a C"; print $obj->C; # outputs "this is a C"` [download] If you want another object with another fixed structure, then you need another class `package Bar; use base qw/Class::StructAccessors/; __PACKAGE__->mk_struct_accessors({X => {Y => Z}});` [download] This will generate accessor method for `Z`. In an nutshell, the above code works when you have finite number of structures that are know at run time. I'm getting the feeling that you want a more dynamic solution that'll work at the instance on any structure; something like: `my $obj = bless {a => {b => {c => 'data for c'}}}, "Class::StructAc +cessorMk2";` [download] Always happy to assist (and code) :-) Please advise.	[reply] [d/l] [select]
Re^4: Generating accessors for complex structures inside the object by KSURi (Monk) on Jan 23, 2008 at 19:00 UTC
> I'm getting the feeling that you want a more dynamic solution that'll work at the instance on any structure; Yep, that will be very usefull not only for me. Though I've solved my own problem (through object redesigning) I'll be glad to read ideas and etc. Thanks for your assist)	[reply]


Don't ask to ask, just ask
	PerlMonks