File Coverage

blib/lib/Data/DefGen.pm

Criterion	Covered	Total	%
statement	42	49	85.7
branch	10	18	55.5
condition			n/a
subroutine	10	11	90.9
pod	0	3	0.0
total	62	81	76.5

package Data::DefGen;

use warnings;
use strict;
use mro qw(c3);

BEGIN {
    require Exporter;
    *import = \&Exporter::import;

    our $VERSION = "1.001001";
    our @EXPORT = qw(def);
}

use Scalar::Util qw(reftype blessed);

# to subclass, copy and EXPORT this function
sub def (&@) { __PACKAGE__->new(data => shift, @_) }

sub new {
    my $class = shift;
    my $self = bless { }, $class;
    $self->_init(@_);
    return $self;
}

sub _init {
    my $self = shift;
    %{ $self } = (
        data => undef,
        @_,
    );

    $self->{obj_cloner} = sub { $_[0] }
      unless UNIVERSAL::isa($self->{obj_cloner}, "CODE");
}

sub gen {
    my $self = shift;
    local $self->{gen_p} = \@_;
    return $self->_gen($self);
}

sub _gen {
    my $self = shift;

    if (defined blessed($_[0]))
    {
        if ($_[0]->isa(ref $self))
        {
            return $self->_gen($_[0]->{data}) if ref($_[0]->{data}) ne "CODE";

            my @data = @{ $self->_gen([ $_[0]->{data}->(@{ $self->{gen_p} }) ]) };
            return @data[0 .. $#data];
        }
        else
        {
            return $self->{obj_cloner}->($_[0]);
        }
    }

    my $type = reftype($_[0]);
    $type or return $_[0];
    $type eq "HASH"   and return { map +($_ => $self->_gen($_[0]->{$_})), keys %{ $_[0] } };
    $type eq "ARRAY"  and return [ map $self->_gen($_), @{ $_[0] } ];
    $type eq "SCALAR" and return \${ $_[0] };
    $type eq "REF"    and return \$self->_gen(${ $_[0] });
    return $_[0];
}

1;


__END__