HashBase.pm

package Test2::Util::HashBase;
use strict;
use warnings;

my %ATTRS;
my %META;

sub _get_inherited_attrs {
    my @todo = @_; 
    my %seen;
    my @all;
    while (my $pkg = shift @todo) {
        next if $seen{$pkg}++;
        my $found = $META{$pkg};
        push @all => %$found if $found;

        no strict 'refs';
        my $isa = \@{"$pkg\::ISA"};
        push @todo => @$isa if @$isa;
    }   

    return \@all;
}

sub _make_subs {
    my ($str) = @_; 
    $ATTRS{$str} ||= {
        uc($str) => sub() { $str },
        $str => sub { $_[0]->{$str} },
        "set_$str" => sub { $_[0]->{$str} = $_[1] },
    };  
    return $ATTRS{$str};
}

sub import {
    my $class = shift;
    my $into = caller;

    my %meta = map { %{_make_subs($_)} } @_; 
    $META{$into} = \%meta;

    my %subs = (%meta, @{_get_inherited_attrs($into)}, new => \&_new);

    no strict 'refs';
    *{"$into\::$_"} = $subs{$_} for keys %subs;
}

sub _new {
    my ($class, %params) = @_; 
    my $self = bless \%params, $class;
    $self->init if $self->can('init');
    $self;
}

1;