I have written two Perl subroutines to flatten and unflatten a complex hash or array key. This can be useful in situations when you are traversing/parsing a complex data structure like JSON and want to store a given complex key to be later used as an index into a modified data structure. The reason for writing this is that the CPAN module Hash::Flatten cannot flatten single keys. Instead it flattens a whole data structure.
use feature qw(say);
use strict;
use warnings;
use Carp;
use Data::Dump qw(dd dump);
use Test::More;
run_test1();
run_test2();
done_testing();
exit;
sub run_test2 {
my @data = (
# Input Output expected
[ ":1.a", [1, "a"] ],
[ ":c.a", "Expected integer array index, found 'c'." ],
);
my ($flat_key, $b);
for my $i (0..$#data) {
my ( $flat_key, $expected ) = @{$data[$i]};
my $error = 0;
eval {
$a = unflatten_key( $flat_key );
is_deeply( $a, $expected, 'unflatten: ' . $flat_key);
};
if ($@) {
$error = 1;
my ( $res ) = $@ =~ /^(.*?) at/;
ok( $res eq $expected, "'$res' --> '$expected'");
}
}
}
sub run_test1 {
my @data = (
# type Input Output expected
[ "hash", ["a\\:.b\\", \1, "cc"], "a\\\$\\:\\.b\\\$.1.cc"],
[ "array", ["c", 3], "First sub item in an array index must be an integer"],
[ "array", [1, 2], ":1:2"],
[ "hash", ["a"], "a"],
[ "hash", [1], "First item in hash key cannot be an array index!"],
[ "hash", [\1], "1"],
[ "hash", ["a", "", "b"], "a..b"],
[ "hash", [], "Empty key array!"],
);
my ($flat_key, $b);
for my $i (0..$#data) {
my ( $type, $a, $expected ) = @{$data[$i]};
my $error = 0;
eval {
$flat_key = flatten_key( $a, type => $type );
};
if ($@) {
$error = 1;
my ( $res ) = $@ =~ /^(.*?) at/;
ok( $res eq $expected, "'$res' --> '$expected'");
}
else {
ok( $flat_key eq $expected, dump($a) . " --> " . $expected);
}
if ( !$error ) {
$b = unflatten_key( $flat_key );
is_deeply( $a, $b, 'unflatten: ' . $flat_key);
}
}
}
# SYNOPSIS
#
# $fkey = flatten_key( $a, type => $type )
#
# DESCRIPTION
#
# Flatten keys in the array @$a. The items in @$a consists of
# numbers, strings, and references, see
# [Data::Diver](https://metacpan.org/pod/Data::Diver).
#
# The key represented by $a should be used to look up an element
# in a nested hash if $type eq "hash", or in a nested array if $type eq "array".
# The default value for $type is "hash".
#
# Numbers represent array indices, and strings represent hash keys. References
# are only needed to represent integer hash keys, like "1". Such keys are not
# very common, but we choose to include support for the general case.
#
# This means that an item of \1 will be treated as a hash key,
# but the number 1, (or the string "1", since perl does not
# distinguish between string type and integer type) will be an array index.
#
# Example: $a = ["a", 1, \2]
# will correspond to a hash { a => [undef, { 2 => undef } ] }
#
# The return value is a flattened key. For example: $fkey = "a:1.2"
# (for the above example).
# We use a dot to indicate that the following item is a hash key, and
# a colon to indicate that the following item is an array index which
# is also consistent with the notation in Data::Diver.
#
# Since the first item in @$a must always be hash key if $type eq "hash",
# the initial dot is omitted for that case
# ( i.e., we do not write $fkey = ".a:1.2" if $type eq "hash" ).
#
# SPECIAL CASES
#
# The returned flattened key will contain escape sequences in some
# special cases. The subroutine 'unflatten_key' will correctly handle
# these escape sequences to reproduce the original.
#
# a) If the key contains a dot or a colon itself, they must be escaped.
# For example $a = ["a.b", "b"] would give (without using any escaping)
# a flattened key "a.b.b", which would be ambigious for later reconstruction.
# Instead, we will return "a\.b.b" which can later be uniquely reconstructed to
# ["a.b", "b"] by unflatten_key().
#
# b) Now that "\." and "\:" means escaped dot and colon, another issue arises:
# Consider for example, $a = ["a\", "b"] which would give "a\.b", but
# then reconstruction would give back wrong answer : ["a.b"]..
# So we also need to escape all backslashes. We will use '\$' to represent
# backslashes. Using this,
# $a = ["a\", "b"] would become "a\$.b", which can be later uniquely reconstructed
#
# ERRORS
# This subroutine croaks if:
#
# - $a is empty
#
# - The first item in $a is a number and $type eq "hash".
#
# - The first item in $a is not a number and $type eq "array".
#
# NOTE
#
# This subroutine, is meant to be used only when you want to flatten one key at a
# time.. If you want to flatten all keys of a complex hash at once, see
# CPAN package Hash::Flatten.
#
# SEE ALSO
#
# - Data::Diver, FreezeThaw.
#
sub flatten_key {
my ( $a, %opt ) = @_;
croak "Empty key array!" if @$a == 0;
$opt{type} //= "hash"; # default value is hash
my $item = $a->[0];
if ( $opt{type} eq "array" ) {
if ( (ref $item) || !_is_integer($item) ) {
croak "First sub item in an array index must be an integer";
}
}
else {
if ( !(ref $item) && _is_integer( $item ) ) {
croak "First item in hash key cannot be an array index!";
}
}
my $fkey = "";
my $sep;
for (@$a) {
my $key = $_; # copy $_ to avoid modifying original array
if ( ref $key ) {
$key = $$key;
$sep = '.';
}
else {
$sep = _is_integer( $key ) ? ":" : ".";
}
$key =~ s/\\/\\\$/g; # escape backslashes
$key =~ s/([.:])/\\$1/g; # escape dot and colon
$fkey .= $sep . $key;
}
return ($opt{type} eq "hash") ? (substr $fkey, 1) : $fkey;
}
# SYNOPSIS
#
# $a = unflatten_key( $fkey )
#
# DESCRIPTION
#
# Returns an array @$a of key items corresponding to the flattened key $fkey.
# See flatten_key(), Hash::Flatten, and Data::Diver for more information.
#
# For arrays, $fkey should start with a ':', and the first sub key should be an integer
# For example: $fkey = ':1.b' will represent an array [undef, {b => undef}]
#
# ERRORS
#
# This subroutine croaks if:
#
# - $fkey is empty,
#
# - a subkey in $fkey with a leading ':' is not an integer.
#
sub unflatten_key {
my ( $fkey ) = @_;
croak "Empty key!" if !$fkey;
my $type = "hash";
if ( substr( $fkey, 0, 1) eq ":" ) {
$fkey = substr $fkey, 1;
$type = "array";
}
my @a = split /(?<!\\)([:.])/, $fkey;
my @b;
for my $i (0..$#a) {
next if $i % 2; # do not consider odd indices
if ( $i > 0) {
$type = ( $a[$i - 1] eq "." ) ? "hash" : "array";
}
my $item = $a[$i];
$item =~ s/\\([:.])/$1/g; # unescape colons and dots
$item =~ s/\\\$/\\/g; # unescape backslashes
if ( $type eq "hash" ) {
if ( _is_integer( $item ) ) {
# use reference type to represent numeric hash keys
$item = \( $item+0 );
}
}
else {
if ( !_is_integer( $item ) ) {
croak "Expected integer array index, found '$item'.";
}
}
push @b, $item;
}
return \@b;
}
sub _is_integer {
my ( $str ) = @_;
return ( $str =~ /\A\d+\z/ );
}
FreezeThawwould do the job just fine. You could add checks for the data-structure compliance. \$\endgroup\$