File Coverage

blib/lib/Data/Transformer.pm

Criterion	Covered	Total	%
statement	53	54	98.1
branch	37	40	92.5
condition	6	10	60.0
subroutine	5	5	100.0
pod	1	2	50.0
total	102	111	91.8

package Data::Transformer;
use strict;

our $VERSION = 0.04;

################ CONSTRUCTOR ################

sub new {
	my ($pk,%opt) = @_;
	my $class = ref($pk) || $pk;
	my $self = \%opt;
	bless($self,$class);
	$self->_selfcheck;
	return $self;
}

################ PUBLIC METHODS ################

sub traverse {
	my ($self,$data) = @_;
	die "Data needs to be a reference" unless ref $data;
	$self->{_seen} = {};
	$self->_node($data);
	return $self->{_node_calls};
}

################ PRIVATE METHODS ###############

my %plainref = map { ($_=>1) } qw(ARRAY HASH CODE SCALAR GLOB);

sub _node {
	my ($self,$data) = @_;
	die "Maximum node calls ($self->{node_limit}) reached"
	  if $self->{_node_calls}++ > $self->{node_limit};

	my $ref = ref $data || '';
	my ($cb_ret,$node_ret);

	return if $ref && $self->{_seen}->{"$data"}++; # circular data structure!

	# Filter data
	if ($plainref{$ref}) { # normal reference
		$cb_ret = $self->{lc($ref)}->($data) if $self->{lc($ref)};
	}
	elsif ($ref) { # blessed reference
		$cb_ret = $self->{$ref}->($data) if $self->{$ref};
	}
	else { # non-reference
		$cb_ret = $self->{normal}->(\$data) if $self->{normal};
	}

	# Recurse into $data (if appropriate):
	if (ref $data eq 'HASH') {
		foreach my $val (values %$data) {
			while (1) {
				if (ref $val) {
					$node_ret = $self->_node($val);
				} else {
					$node_ret = $self->{normal}->(\$val) if $self->{normal};
				}
				if (ref $node_ret eq 'CODE') {
					$val = $node_ret->();
					next;
				}
				last;
			}
		}
	}
	elsif (ref $data eq 'ARRAY') {
		foreach my $elm (@$data) {
			while (1) {
				if (ref $elm) {
					$node_ret = $self->_node($elm);
				} else {
					$node_ret = $self->{normal}->(\$elm) if $self->{normal};
				}
				if (ref $node_ret eq 'CODE') {
					$elm = $node_ret->();
					next;
				}
				last;
			}
		}
	}

	return $cb_ret;
}


sub _selfcheck {
	my $self = shift;
	my $found = 0;
	for my $k (keys %$self) {
		next if $k eq 'node_limit';
		$found++;
		die "The value for the '$k' option needs to be a coderef"
		  unless ref $self->{$k} eq 'CODE';
	}
	unless ($found) {
		die "You need to specify an action for some node type";
	}
	$self->{_node_calls} = 0;
	$self->{node_limit} ||= 2**16;
	die "Cannot set node_limit higher than 2**20-1"
	  if $self->{node_limit} > 2**20-1;
}

1;
__END__