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;