File Coverage

blib/lib/Data/DefGen.pm

Criterion	Covered	Total	%
statement	38	44	86.3
branch	12	18	66.6
condition			n/a
subroutine	9	10	90.0
pod	0	3	0.0
total	59	75	78.6

package Data::DefGen;

use warnings;
use strict;

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

    our $VERSION = "1.001003";
    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->{data}) if ref($self->{data}) ne "CODE";

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

sub _gen {
    my $self = shift;

    if (defined blessed($_[0]))
    {
        return $_[0]->isa(ref $self)
          ? $_[0]->gen(@{ $self->{gen_p} })
          : $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__