File Coverage

lib/Kephra/Config/Tree.pm

Criterion	Covered	Total	%
statement	19	41	46.3
branch	9	28	32.1
condition			n/a
subroutine	7	11	63.6
pod	0	7	0.0
total	35	87	40.2

package Kephra::Config::Tree;
our $VERSION = '0.02';
=head1 NAME

Kephra::Config::Tree - manipulation of config data

=head1 DESCRIPTION

=cut
use strict;
use warnings;
#
# single node manipulation
#
sub _convert_node_2_AoH {
	my $node = shift;
	if (ref $$node eq 'ARRAY') {
		return $$node if ref $$node->[0] eq 'HASH';
	} elsif (ref $$node eq 'HASH') {
		my %temp_hash = %{$$node};
		push( my @temp_array, \%temp_hash );
		return $$node = \@temp_array;
	} elsif (not ref $$node) {
		my @temp_array = ();
		return $$node = \@temp_array;
	}
}

sub _convert_node_2_AoS {
	my $node = shift;
	if (ref $$node eq 'ARRAY') {
		return $$node;
	} elsif ( 'SCALAR' eq ref $node )  {
		if ($$node) {
			push( my @temp_array, $$node );
			return $$node = \@temp_array;
		} else {
			my @temp_array = ();
			return $$node = \@temp_array;
		}
	}
}
#
# single node manipulation
#
sub get_subtree { &subtree }
sub subtree {
	my $config = shift;
	return unless ref $config;
	my $path = shift;
	for (split '/', $path) {
		$config = $config->{$_} if defined $config->{$_};
	}
	return $config;
}

sub flat_keys {
	my $config = shift;
	return unless ref $config eq 'HASH';
	my %flathash;
	for ( keys %$config ){

	}
}
#sub _parse_and_copy_node {
	#my ($parent_node, $parent_id) = @_;
	#no strict;
	#for ( keys %$parent_node ){
		#$cmd_id = $parent_id . $_;
		#$leaf_type = ref $parent_node->{$_};
		#if (not $leaf_type) {
			#$list{$cmd_id}{$target_leafe} = $parent_node->{$_}
				#if $parent_node->{$_};
		#} elsif ($leaf_type eq 'HASH'){
			#_parse_and_copy_node($parent_node->{$_}, $cmd_id . '-')
		#}

#
# tree operations
#
my %copy = (
	''     => sub {          $_[0]    },
	SCALAR => sub {       \${$_[0]}   },
	REF    => sub { \copy( ${$_[0]} ) },
	ARRAY  => sub { [map {copy($_)} @{$_[0]} ] },
	HASH   => sub { my %copy = map { copy($_) } %{$_[0]}; \%copy; },
);
my %merge = (
	''     => sub { $_[0] },
	SCALAR => sub { \${$_[0]} },
	REF    => sub { \merge( ${$_[0]}, ${$_[1]} ) },
	ARRAY  => sub { [map { copy($_) } ( @{$_[0]}, @{$_[1]} ) ] },
	HASH   => sub {
			my %copy = map
				{ $_, merge( $_[0]{$_}, $_[1]{$_} ) }
				(keys %{$_[0]}, keys %{$_[1]} );
			\%copy;
	},
);
my %update = (
	''     => sub { $_[1] },
	SCALAR => sub { \${$_[1]} },
	REF    => sub { \update( ${$_[0]}, ${$_[1]} ) },
	ARRAY  => sub { [map { copy($_) } ( @{$_[1]} ) ] },
	HASH   => sub {
			my %copy = map {
				$_, exists $_[1]{$_}
					? update( $_[0]{$_}, $_[1]{$_} )
					: copy( $_[0]{$_} )
				} keys %{$_[0]} ;
			\%copy;
	},
);
my %diff = (
	''     => sub { $_[0] ne $_[1] ? $_[0] : undef },
	SCALAR => sub { ${$_[0]} ne ${$_[1]} ? \${$_[0]} : undef },
 	REF    => sub {
			my $diff = diff( ${$_[0]}, ${$_[1]} );
			defined $diff ? \$diff : undef
	},
	ARRAY  => sub { [map { copy($_) }  @{$_[0]}  ] },
	HASH   => sub {
			my %diff;
			for ( keys %{$_[0]} ) {
				my $diff = exists $_[1]{$_}
							? diff( $_[0]{$_}, $_[1]{$_} )
							: copy( $_[0]{$_} )
				;
				$diff{$_} = $diff if defined $diff;
			}
			return scalar keys %diff > 0 ? \%diff : undef;
	},
);
sub copy { $copy{ ref $_[0] }( $_[0] ) }
sub merge {
	my ($lref, $rref) = (ref $_[0], ref $_[1]);
	$lref eq $rref
		? $merge{ $lref }( $_[0], $_[1] )
		: defined $_[0]
			? $copy{ $lref }( $_[0] )
			: $copy{ $rref }( $_[1] )
	;
}
sub update { # left dictates the content, right the structure
	my ($lref, $rref) = (ref $_[0], ref $_[1]);
	$lref eq $rref
		? $update{ $lref }( $_[0], $_[1] )
		: $copy{ $rref }( $_[0] )
	;
}
sub diff {
	my ($lref, $rref) = (ref $_[0], ref $_[1]);
	$lref eq $rref
		? $diff{ $lref }( $_[0], $_[1] )
		: $copy{ $lref }( $_[0] ) # undef
	;
}

1;