3
\$\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\$
2
  • 2
    \$\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\$ Apr 16, 2015 at 9:49
  • 1
    \$\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\$ Apr 16, 2015 at 10:00

0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Browse other questions tagged or ask your own question.