0

I want to create a nested hash by reading values from multi dimention arrays which are separated by -> e.g.

Array 1: key1->key2->key3->value
Array 2: key1->key2->value
Array 3: key1->value

When key has value and sub keys as well e.g. key2 has value and another key key3 as well then get error "Not a HASH reference ".Seem it is overwriting previous hash and considering it array.

Help is appreciated. I have tried to debug and print the values of variables and output by using dumper module and see that it is ARRAY reference and not hash.

in order to repro, please create .txt files e.g. from 1 to 3.txt in any folder and have below content in these files 1.txt : /TEST-TAG = ABC->DEF->fma->GHI/ 2.txt:/*TEST-TAG = ABC->DEF->fma 3.txt:/*TEST-TAG = ABC->DEF and then have in perl script

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

my @lines=`grep -R 'TEST-TAG =' <FOLDER where .txt files present>`;
my $hash;

#parse the lines which has pattern /\*TEST-TAG = ABC->DEF->fma->GHI\*/
foreach (@lines)
    {
    print "line is $_\n";

    my($all_cat) = $_ =~ /\=(.*)\*\//;
    print "all cat is $all_cat\n";

    my($testname) = $_ =~ /\/.*\/(.*)\./;
    print "testname is $testname\n";

    if (!$all_cat eq "") {
        $all_cat =~ s/ //g;
        my @ts = split(',', $all_cat);
        print "ts is @ts\n";
        my $i;
        foreach (@ts) {
            my @allfeat = split('->',$_);
            my $count =  scalar @allfeat;
            for ($i = 0; $i<$count; $i++) {
                my @temparr = @allfeat[$i..$count-1];
                print "temparr is @temparr\n";
                push @temparr, $testname;
                ToNestedHash($hash, @temparr);
            }
        }
    }
}
sub ToNestedHash {
        my $ref   = \shift;
        print "sandeep in ref $ref\n";
        print "sandeep in ref", ref($ref), "\n";
        my $h     = $$ref;
        print "sandeep h $h\n";
        my $value = pop;
        print "sandeep value is $value\n";
        print "sandeep array is @_\n";
        print "refrence",  ref($h), "\n";
        foreach my $i (@_) {
        print " before INDEX $i\n";
        print Dumper($ref);
        $ref =\$$ref->{ $i };
        print "after INDEX $i\n";
        print Dumper($ref);
        }
        if (!isinlist(\@{$$ref},$value)) {
            push @{$$ref}, $value;
        }
        return $h;
    }
    # If element exists in the list
    sub isinlist {
        my ($aref, $key) = ($_[0], $_[1]);

        foreach my $elem (@$aref){
            if ($elem eq $key) {
                return 1;
            }
        }
        return 0;
    }

I get this output with debug prints

line is File.txt:/*TEST-TAG = ABC->DEF->fma->GHI*/

all cat is  ABC->DEF->fma->GHI
testname is hmma_884_row_row_f16_f16
ts is ABC->DEF->fma->GHI
temparr is ABC DEF fma GHI
sandeep in ref REF(0x12a1048)
sandeep in refREF
sandeep h HASH(0x12a09a0)
sandeep value is hmma_884_row_row_f16_f16
sandeep array is ABC DEF fma GHI
refrenceHASH

REF
temparr is DEF fma GHI
sandeep in ref REF(0x12a1048)
sandeep in refREF
sandeep h HASH(0x12a09a0)
sandeep value is hmma_884_row_row_f16_f16
sandeep array is DEF fma GHI
refrenceHASH

REF
temparr is fma GHI
sandeep in ref REF(0x12a1048)
sandeep in refREF
sandeep h HASH(0x12a09a0)
sandeep value is hmma_884_row_row_f16_f16
sandeep array is fma GHI
refrenceHASH
Not a HASH reference at createjson.pl line 80.

problematic line is $ref =\$$ref->{$_} foreach (@_);

18
  • Global symbol "@lines" requires explicit package name (did you forget to declare "my @lines"?) at .code.tio line 6. Commented Jan 7, 2019 at 8:17
  • it was there in my code but I did not add it in sample.Added it now. Commented Jan 7, 2019 at 8:44
  • 1
    if (!$all_cat eq "") is an odd construct. Why go out of your way to make it sound like you're testing for emptiness when you're actually - in a roundabout way - testing truthness? !$all_cat is evaluated first, giving a truth value, that will be converted to a string (either "1" or "", the empty string) for string comparison. It's clearer to say just if ($all_cat) if you want truthness or if ($all_cat ne '') if you want non-empty. Commented Jan 7, 2019 at 9:43
  • 1
    Isn't if (!$all_cat eq "") just a deliberately confusing way to write if (length $all_cat) ? Commented Jan 7, 2019 at 9:52
  • 2
    Also, there's a lot of very confusing reference syntax in here. I'm not sure if the code was written by someone who was very clever or someone who wasn't anywhere near as clever as they thought they were :-) Commented Jan 7, 2019 at 9:54

1 Answer 1

2

After sleeping on it, I realized where you were trying to go with this more. Your issue of concern is the fact that you're trying to use some hash values as both arrays and as hashes. There are two approaches to dealing with this. Detect and handle it, or avoid it. The avoid code is much cleaner, so I'll show that.

As I mentioned in my original answer, I'm not sure what you had in mind for the 'Dumper' lines, but Data::Dump is probably a useful replacement for what you were using, with less complication than the Data::Dumper module that I was thinking you were somehow managing to use. I also chose to still provide a replacement for your file name regex, as I still don't want to bother with a full path name.

#!/usr/bin/perl

use strict;
use warnings;

use Data::Dump;

my @lines = `grep -R 'TEST-TAG =' foo`;
my $hash;

$| = 1; # keep STDOUT and STDERR together

#parse the lines which has pattern /\*TEST-TAG = ABC->DEF->fma->GHI\*/
foreach (@lines) {
    print "line is $_\n";

    my($all_cat) = $_ =~ /\=(.*)\*\//;
    print "all cat is $all_cat\n";

    my($testname) = $_ =~ /(?:.*\/)?(.*?)\./;
    print "testname is $testname\n";

    if ($all_cat ne "") {
        $all_cat =~ s/ //g;
        my @ts = split(',', $all_cat);
        print "ts is @ts\n";
        my $i;
        foreach (@ts) {
            my @allfeat = split('->',$_);
            my $count =  scalar @allfeat;
            for ($i = 0; $i<$count; $i++) {
                my @temparr = @allfeat[$i..$count-1];
                print "temparr is @temparr\n";
                push @temparr, $testname;
                ToNestedHash($hash, @temparr);
            }
        }
    }
}

sub ToNestedHash {
    my $ref   = \shift;
    print "sandeep in ref ";
    dd $ref;
    my $h     = $$ref;
    print "sandeep h ";
    dd $h;
    my $value = pop;
    print "sandeep value is $value\n";
    print "sandeep array is @_\n";
    print "refrence",  ref($h), "\n";
    foreach my $i (@_) {
        print " before INDEX $i\n";
        dd $ref;
        $ref =\$$ref->{ $i };
        print "after INDEX $i\n";
        dd $ref;
    }
    $ref =\$$ref->{ _ARRAY };
    if (!isinlist(\@{$$ref},$value)) {
        push @{$$ref}, $value;
    }
    return $h;
}
# If element exists in the list
sub isinlist {
    my ($aref, $key) = ($_[0], $_[1]);

    foreach my $elem (@$aref){
        if ($elem eq $key) {
            return 1;
        }
    }
    return 0;
}
Sign up to request clarification or add additional context in comments.

1 Comment

This line $ref =\$$ref->{ _ARRAY }; did the magic.Thanks @Ed.

Your Answer

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

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.