Geek asks and answers

What is a quick way to replace identical branches inside nested structures with links?

Is there a module available for Perl that can scan an arbitrarily large nested structure of hashes and arrays and replace all the same branches (those that Test::Deep::cmp_deeplysay “ok” for example ) with links to only one value?

I already have my own solution for this problem, but I would prefer to use the existing fast XS-module, if available.

An example of the original structure, as shown by Data :: Dumper :

$VAR1 = {
    'other_elems' => [
        {
            'sub_elements' => [
                {'id' => 333},
                {
                    'props' => ['attr5', 'attr6'],
                    'id'    => 444
                }
            ],
            'other_key_for_attrs' => ['attr1', 'attr5'],
            'id'                  => 222
        },
        {
            'sub_elements' => [{'id' => 333}],
            'id'           => 111
        }
    ],
    'elems' => [
        {
            'attrs' => ['attr1', 'attr5'],
            'id'    => 1
        },
        {
            'parent' => 3,
            'attrs'  => ['attr1', 'attr5'],
            'id'     => 2
        },
        {
            'attrs' => ['attr5', 'attr6'],
            'id'    => 3
        },
        {
            'attrs' => ['attr5', 'attr6'],
            'id'    => 4
        }
    ]
};

An example of the expected result structure:

$VAR1 = {
    'other_elems' => [
        {
            'sub_elements' => [
                {'id' => 333},
                {
                    'props' => ['attr5', 'attr6'],
                    'id'    => 444
                }
            ],
            'other_key_for_attrs' => ['attr1', 'attr5'],
            'id'                  => 222
        },
        {
            'sub_elements' =>
              [$VAR1->{'other_elems'}[0]{'sub_elements'}[0]],
            'id' => 111
        }
    ],
    'elems' => [
        {
            'attrs' => $VAR1->{'other_elems'}[0]{'other_key_for_attrs'},
            'id'    => 1
        },
        {
            'parent' => 3,
            'attrs'  => $VAR1->{'other_elems'}[0]{'other_key_for_attrs'},
            'id'     => 2
        },
        {
            'attrs' =>
              $VAR1->{'other_elems'}[0]{'sub_elements'}[1]{'props'},
            'id' => 3
        },
        {
            'attrs' =>
              $VAR1->{'other_elems'}[0]{'sub_elements'}[1]{'props'},
            'id' => 4
        }
    ]
};
+3
source share
1 answer

, , . , , , ( , ).

#!/usr/bin/env perl
use warnings;
use strict;

use Data::Dumper;

my $hash = {
    foo => ['bar', {baz => 3}],
    qux => [{baz => 3}, ['bar', {baz => 3}]]
};

{   
    local $Data::Dumper::Sortkeys = 1;
    local $Data::Dumper::Indent = 0;
    local $Data::Dumper::Terse = 1;

    my %seen_branches;
    my @refs_to_check = \(values %$hash);
    while (my $ref = shift @refs_to_check) {
        my $serial = Dumper($$ref);
        if (my $existing = $seen_branches{$serial}) {
            $$ref = $existing;
        } else {
            $seen_branches{$serial} = $$ref;
            if (ref($$ref) eq 'ARRAY') {
                push @refs_to_check, \(@{$$ref});
            } elsif (ref($$ref) eq 'HASH') {
                push @refs_to_check, \(values %{$$ref});
            }
        }
    }
}

print Dumper $hash;
+2

More articles:


All Articles