Perl: Create hash of hashes, last key as a reference to an array

Question

Need a little help creating hashrefs of hashrefs, with the last key as a reference to an array.

use Data::Dumper;

   my $foo = "a:b:c:d:a";
   my $bar = "a:b:c:d:z";
   my $hoh = {};

   sub createHash {

      my ($hoh,$orig,$rest,$last) = @_;
      $rest = $rest || $orig;
      $_    = $rest;

      if (/^(.*?):(.*)$/) { 
         $hoh->{$1} = $hoh->{$1} || {};
         createHash($hoh->{$1},$orig,$2,$1);
      }
      elsif (defined($last)) {
         push (@{$hoh->{value}} , [$rest,$orig]);
      }

      return $hoh;
   }

   $hoh = createHash($hoh,$foo,undef);
   $hoh = createHash($hoh,$bar,undef);

   print Dumper($hoh);

What's Wanted:

$VAR1 = {
          'a' => {
                   'b' => {
                            'c' => {
                                     'd' => [
                                               [
                                                 'a',
                                                 'a:b:c:d:a'
                                               ],
                                               [
                                                 'z',
                                                 'a:b:c:d:z'
                                               ]
                                            ]
                                   }
                          }
                 }
        };

You can compare this with the output from codepad. Notice the subtle difference; instead of 'd' being a hashref that has an arrayref value, 'd' is the arrayref and there is no value.

in the least clever way possible to create that... my $var = { }; $var->{a}{b}{c}{d} = [ [ 'a', 'a:b:c:d:a' ], [ 'z', 'a:b:c:d:z' ] ]; not posting as an answer because I'm sure this is not as simple as what you've posted. or in all honesty, not really sure what you're trying to do. — xenoterracide
– xenoterracide, Commented Oct 15, 2011 at 2:07
However, jdporter on PerlMonks came up with something similar (automated), using eval. That's what I was asking Tank about — vol7ron
– vol7ron, Commented Oct 15, 2011 at 15:23

Tanktalus · Accepted Answer · 2011-10-13 20:07:21Z

2

I'd suggest Data::Diver, though it is a bit awkward since it wants to always create scalar references at the end, and that's not what we want. Thus, I cheat a bit.

The main thing here is that we can save effort (mostly in maintenance) by deciphering all the keys at once, and using a while loop (inside Data::Diver) instead of recursion, which is, by its nature, a bit more fun to decipher :-) Combine that with the fact that even if it were recursion, it'd be hidden in a nice, neat function call, it's a double win :-)

use Data::Dumper;
use Data::Diver qw(DiveRef);

my $foo = "a:b:c:d:a";
my $bar = "a:b:c:d:z";
my $hoh = {};

sub add_item
{
    my $href = shift;
    my $str  = shift;

    my @keys = split /:/, $str;

    # force an array to be autovivified if it isn't already there.
    # (this is kinda cheating)
    my $cheat  = DiveRef($href, @keys[0..$#keys-1], 0);
    my $ref = DiveRef($href, @keys[0..$#keys-1]);

    # if we cheated (thus $$cheat will be undef), we need to pop that
    # off.
    pop @$$ref unless $$cheat;

    # store this at the end.
    push @{$$ref}, [ $keys[-1], $str ];

    return;
}

add_item($hoh, $foo);
add_item($hoh, $bar);
print Dumper($hoh);

Hope that helps,

UPDATE: After conversing with tye, he provided a more concise way to do this. It uses Data::Diver still, but has a much simpler workaround embedded. (His claim is that perl has a bug here with :lvalue subs and push - I don't know better, so I'll take his word.)

use Data::Dumper;
use Data::Diver qw(DiveRef DiveVal);

my $foo = "a:b:c:d:a";
my $bar = "a:b:c:d:z";
my $hoh = {};

sub add_item
{
    my $href = shift;
    my $str  = shift;

    my @keys= split /:/, $str;
    my $last= pop @keys;
    push @{ DiveVal( $href, \( @keys ) ) ||= []}, [ $last, $str ];


    return;
}

add_item($hoh, $foo);
add_item($hoh, $bar);
print Dumper($hoh);

edited Oct 13, 2011 at 20:07

answered Oct 12, 2011 at 21:56

Tanktalus

22.5k5 gold badges44 silver badges71 bronze badges

Sign up to request clarification or add additional context in comments.

4 Comments

vol7ron Over a year ago

+1, but codepad didn't have Diver installed, so I'll have to test that out on my homebox. Could you take a look at my answer and see if I'm too far off.

vol7ron Over a year ago

Also, would you say this is a bad approach? Should I just keep it as HoH?

Tanktalus Over a year ago

jdporter did that to dynamically create perl code that would be what you want - though I suspect it wouldn't quite work, but is a quick-and-easy way to do most of your work. As for if this is a bad approach, that really depends. I've had nested hashes deeper than this before, and I've left them flattened as well. All depends on what you want to do afterward.

vol7ron Over a year ago

nested hashes are fine, but arrays at the end of the nested hash make things less robust. I'm thinking if there's ever a case that you have something like 'a:b:e', it'll try to add an array to the hashref. Mind you the lengths are the same for now, but I don't know if the project scope may change (but that's a problem separate from what I've asked)

Hynek -Pichi- Vychodil · Accepted Answer · 2011-10-12 22:21:47Z

1

perl -MData::Dumper -F: -anle'($p,$l)=splice@F,-2,2;$x=\$h;$x=\($$x->{$_}||={})for@F;push@{$$x->{$p}||=[]},[$l=>$_]}{print Dumper($h)' <<EOI
a:b:c:d:a
a:b:c:d:z
a:b:c:d:f
EOI

edited Oct 12, 2011 at 22:21

answered Oct 12, 2011 at 22:15

Hynek -Pichi- Vychodil

26.2k5 gold badges55 silver badges75 bronze badges

Comments

MisterEd · Accepted Answer · 2011-10-13 20:09:23Z

1

~~Change~~

push (@{$hoh->{value}} , [$rest,$orig]);

to

push (@{$hoh->{$last}} , [$rest,$orig]);

EDIT: Sorry, I was a little slow on the uptake but I finally see what's wrong with my answer. If you're still interested, you're original code was very close. A couple of tweaks got it working:

use Data::Dumper;

my $foo = "a:b:c:d:a";
my $bar = "a:b:c:d:z";
my $hoh = {};

sub createHash {

    my ($hoh,$orig,$rest,$last) = @_;
    $rest = $rest || $orig;
    $_    = $rest;

    if (/^(.?):(.+)$/) {
        $_ = $1;
        $rest = $2;
        if ($rest =~ /:/) {
            $hoh->{$_} = $hoh->{$_} || {};
            createHash($hoh->{$_},$orig,$rest,$_);
        } else {
            push(@{$hoh->{$_}}, [$rest, $orig]);
        }
    }

    return $hoh;
}

$hoh = createHash($hoh,$foo,undef);
$hoh = createHash($hoh,$bar,undef);

print Dumper($hoh);

edited Oct 13, 2011 at 20:09

answered Oct 12, 2011 at 23:17

MisterEd

1,7451 gold badge14 silver badges15 bronze badges

3 Comments

vol7ron Over a year ago

That won't work. $hoh overwrites itself to the last hashref in the chain, so you'd have a double 'd' and you can't do @{$hoh} = [...] because you're trying to change the hashref to an arrayref.

MisterEd Over a year ago

It works fine. Paste it into a file, change value to $last, and run it yourself...

vol7ron Over a year ago

codepad.org/Odo711t6 - as you can see there are two keys with the value d, that's because the last $hoh is equal to $hoh->{$last} (and it's already a hashref so you can't turn it into an array).

Community · Accepted Answer · 2020-06-20 09:12:55Z

No recursion necessary: http://codepad.org/XsMCDW2y

use Data::Dumper;
my $hoh = {};

   foreach my $str ('a:b:c:d:a','a:b:c:d:z'){      
      my @vals    = split /:/,$str;
      my $hr      = $hoh;
      my $lastkey = @vals[-2];

      for (0..$#vals-2){
         $hr->{$vals[$_]}= $hr->{$vals[$_]} || {};
         $hr=$hr->{$vals[$_]};
      }
      if (defined $lastkey){
         push @{$hr->{$lastkey}}, [@vals[-1], $str];
      }
   }

print Dumper($hoh);

After looking back at Hynek's, I think we're using a similar approach

Or using recursion: http://codepad.org/xVPuCO1N

use Data::Dumper;

   my $foo = "a:b:c:d:a";
   my $bar = "a:b:c:d:z";
   my $hoh = {};

   sub createHash {
      my ($hoh,$str_orig,$str_rest,$lastkey,$parent) = @_;

      $str_rest = $str_rest || $str_orig || "";
      $_        = $str_rest;

      if (/^(.*?):(.*)$/)
      {
         $parent    = $hoh;
         $hoh->{$1} = $hoh->{$1} || {};
         createHash($hoh->{$1},$str_orig,$2,$1,$parent);
      }
      elsif (defined($lastkey))
      {
         delete($parent->{$lastkey}) if ref $parent->{$lastkey} ne "ARRAY";
         push (@{$parent->{$lastkey}} , [$str_rest,$str_orig]);
      }
      return $hoh;
   }
   $hoh = createHash($hoh,$foo);
   $hoh = createHash($hoh,$bar);

   print Dumper($hoh);

Collectives™ on Stack Overflow

Perl: Create hash of hashes, last key as a reference to an array

What's Wanted:

4 Answers 4

4 Comments

Comments

3 Comments

No recursion necessary: http://codepad.org/XsMCDW2y

Or using recursion: http://codepad.org/xVPuCO1N

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

What's Wanted:

4 Answers 4

4 Comments

Comments

3 Comments

No recursion necessary: http://codepad.org/XsMCDW2y

Or using recursion: http://codepad.org/xVPuCO1N

Comments

Your Answer

Sign up or log in

Post as a guest

Related