2
\$\begingroup\$

I have written two Perl subroutines to flatten and unflatten a complex hash or array key. This can be useful in situation 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/ );
}
\$\endgroup\$
  • \$\begingroup\$ Sorry if I'm ignorant, but it seems to me that FreezeThaw would do the job just fine. You could add checks for the data-structure compliance. \$\endgroup\$ – Patrick J. S. Apr 16 '15 at 9:49
  • \$\begingroup\$ @PatrickJ.S. Thanks! FreezeThaw seems to provide a good solution yes.. and maybe I should have done some more searching on CPAN before writing this .. \$\endgroup\$ – Håkon Hægland Apr 16 '15 at 10:00

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.