Dynamically/recursively building hashes in Perl?

问题:

I'm quite new to Perl and I'm trying to build a hash recursively and getting nowhere. I tried searching for tutorials to dynamically build hashes, but all I could find were introductory articles about hashes. I would be grateful if you point me towards the right direction or suggest a nice article/tutorial.

I'm trying to read from a file which has paths in the form of

one/two/three
four
five/six/seven/eight

and I want to build a hash like

VAR = {
    one : {
        two : {
            three : ""
        }
    }
    four : ""
    five : {
        six : {
            seven : {
                 eight : ""
            }
        }
    }
}

The script I'm using currently is :

my $finalhash = {}; 
my @input = <>;

sub constructHash {
    my ($hashrf, $line) = @_; 
    @elements = split(/\//, $line);
    if(@elements > 1) {
        $hashrf->{shift @elements} = constructHash($hashrf->{$elements[0]}, @elements ); 
    } else {
        $hashrf->{shift @elements} = ""; 
    }
    return $hashrf;
}

foreach $lines (@input) {
    $finalhash = constructHash($finalhash, $lines);
}

回答1:

This is a bit far-fetched, but it works:

sub insert {
  my ($ref, $head, @tail) = @_;
  if ( @tail ) { insert( \%{$ref->{$head}}, @tail ) }
  else         {            $ref->{$head} = ''      }
}

my %hash;
chomp and insert \%hash, split( '/', $_ ) while <>;

It relies on autovivification, which is admittedly a bit advanced for a beginner.

What would probably make any answer to your question a bit twisted is that you ask for empty strings in the leaves, which is of a different "type" than the hashes of the nodes, and requires a different dereferencing operation.

回答2:

Data::Diver covers this niche so well that people shouldn't reinvent the wheel.

use strict;
use warnings;
use Data::Diver 'DiveVal';
use Data::Dumper;

my $root = {};
while ( my $line = <DATA> ) {
    chomp($line);
    DiveVal( $root, split m!/!, $line ) = '';
}
print Dumper $root;
__DATA__
one/two/three
four
five/six/seven/eight

回答3:

I ran your code and found a few problems:

• you haven't scoped @elements properly.
• with that recursion you're creating a hash that references itself, which is not what you want.
• in your outermost call, the second arg to constructHash() is a string, but on the recursive call inside, you pass an array of @elements

Try this.

use Data::Dumper;

my $finalhash = {}; 
my @input = split "\n", <<INPUT;
one/two/three
four
five/six/seven/eight
INPUT

sub constructHash {
    my $line = shift; 
    my ($first, $remainder) = split(/\//, $line,2);

    if ($remainder) {
        return { $first => constructHash($remainder) } ; 
    } else {
        return { $first , "" }; 
    }
}

foreach $lines (@input) {
    my $linehash = constructHash($lines);
    my $firstkey = (keys %$linehash)[0];
#    print Dumper $linehash;
    $finalhash->{$firstkey} = $linehash->{$firstkey};
} 


print Dumper $finalhash;

It produces

$VAR1 = {
          'five' => {
                      'six' => {
                                 'seven' => {
                                              'eight' => ''
                                            }
                               }
                    },
          'one' => {
                     'two' => {
                                'three' => ''
                              }
                   },
          'four' => ''
        };

Remember, Perl hashes aren't ordered.

回答4:

I've never done something like this, so this approach is likely to be wrong, but well, here's my shot:

use 5.013;
use warnings;
use Data::Dumper;

sub construct {
   my $hash = shift;
   return unless @_;

   return construct($hash->{shift()} //= {}, @_);
}

my %hash;

while (<DATA>) {
   chomp;
   construct(\%hash, split m!/!);
}

say Dumper \%hash;

__DATA__
one/two/three
four
five/six/seven/eight

EDIT: Fixed!

EDIT2: A (I think) tail-call optimized version, because!

sub construct {
   my $hash = shift;
   return unless @_;
   unshift @_, $hash->{shift()} //=  @_ ? {} : '';

   goto &construct;
}

回答5:

The basics:

• the Perl data structure cookbook
• autovivification