need to modify perl Deep::Hash::Utils

user_11357415 0
Viewed 85

i am very new to perl. i am trying to use the below code from CPAN.

my $C;

# Recursive version of C<each>;
sub reach {
    my $ref = shift;


    if (ref $ref eq 'HASH') {


        if (defined $C->{$ref}{v}) {
            if (ref $C->{$ref}{v} eq 'HASH') {
                if (my @rec = reach($C->{$ref}{v})) {
                    return ($C->{$ref}{k},@rec);
                } 
            } elsif (ref $C->{$ref}{v} eq 'ARRAY') {
                if (my @rec = reach($C->{$ref}{v})) {
                    if (defined $C->{$ref}{k}) {
                        return $C->{$ref}{k},@rec;
                    }
                    return @rec;
                } 

            }
            undef $C->{$ref};
        } 


        if (my ($k,$v) = each %$ref) {
            $C->{$ref}{v} = $v;
            $C->{$ref}{k} = $k;
            return ($k,reach($v));
        }

        return ();


    } elsif (ref $ref eq 'ARRAY') {


        if (defined $C->{$ref}{v}) {
            if (ref $C->{$ref}{v} eq 'HASH' || 
                ref $C->{$ref}{v} eq 'ARRAY') {

                if (my @rec = reach($C->{$ref}{v})) {
                    if (defined $C->{$ref}{k}) {
                        return $C->{$ref}{k},@rec;
                    }
                    return @rec;
                } 
            } 
        }



        if (my $v = $ref->[$C->{$ref}{i}++ || 0]) {
            $C->{$ref}{v} = $v;
            return (reach($v));
        }

        return ();
    }
    return $ref;
}

input:

bar => {cmd_opts => { gld_upf => ['abc' , 'def']} }

current output:

[bar, cmd_opts, gld_upf, abc]

[bar, cmd_opts, gld_upf, def]

desired output:

[bar, cmd_opts, gld_upf, ['abc', 'def']]

also, what are the concepts that are being used in this code? are there any books/courses i can take for this?

perl
1 Answers

also, what are the concepts that are being used in this code? are there any books/courses i can take for this?

The code mentioned by you from the Deep::Hash::Utils CPAN module is mainly handling nested data structures.

A couple of places to read about these:

In the most basic case, in these nested data structures, every node has one of the following types:

  • scalar
  • hashref
  • arrayref

In turn, the values in the array pointed to by an arrayref can be of type scalar/hashref/arrayref. The same goes for the values of the hash pointed to by an arrayref, it can be of type scalar/hashref/arrayref.

This induces a tree-like structure. The algorithm for traversing such a tree is depth-first search where some additional logic is required to check the type of the node and depending on the type decide how to proceed further down the tree.

To make a parallel, all of this is not that much different from traversing a filesystem hierarchy (see link1, link2).

A bigger list called perlres on Perl resources is available.

In this specific case, the function reach from Deep::Hash::Utils acts as an iterator, and it returns all paths descending from the root down to each leaf. Whenever a @path to a leaf is found, its elements are compared side-by-side with another list called @output, and there are three cases:

  • there's no element on that position, so we store it
  • the elements are equal, so we skip them
  • the elements are different, so we merge them together in a list
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
use Deep::Hash::Utils qw/reach/;

my $input = { bar => {cmd_opts => { gld_upf => ['abc' , 'def']} } };

my @output = ();

while (my @path = reach($input)) {
    for(my $i=0;$i<=$#path;$i++){
        if(defined $output[$i]) {
            if(ref($output[$i]) eq "") {
                if($output[$i] eq $path[$i]) {
                    next;
                };
                my $e1 = $output[$i];
                my $e2 = $path[$i];
                $output[$i] = [$e1,$e2];
            }elsif(ref($output[$i]) eq "ARRAY"){
                push @{$output[$i]}, $path[$i];
            };
        } else {
            $output[$i] = $path[$i];
        };
    };
}

print Dumper \@output;

OUTPUT:

$VAR1 = [
          'bar',
          'cmd_opts',
          'gld_upf',
          [
            'abc',
            'def'
          ]
        ];
user_8275190
Related