Динамически / рекурсивно строит хеши в Perl?

Я совершенно новичок в Perl и пытаюсь рекурсивно создать хэш и ничего не получится. Я пытался найти учебники для динамического построения хэшей, но все, что я мог найти, это вводные статьи о хэшах. Буду признателен, если вы укажете мне правильное направление или предложите хорошую статью / учебник.

Я пытаюсь прочитать из файла, который имеет пути в виде

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

и я хочу создать хеш как

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

Сценарий, который я использую в настоящее время:

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);
}

5 ответов

Решение

Это немного надумано, но это работает:

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

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

Это полагается на автовивификацию, которая, по общему признанию, немного продвинута для новичка.

Вероятно, любой ответ на ваш вопрос несколько искажается, если вы запрашиваете пустые строки в листьях, которые имеют "тип", отличный от хэшей узлов, и требуют другой операции разыменования.

Data::Diver покрывает эту нишу так хорошо, что люди не должны изобретать велосипед.

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

Я никогда не делал что-то подобное, так что такой подход, скорее всего, будет неправильным, но хорошо, вот мой шанс:

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

РЕДАКТИРОВАТЬ: Исправлено!

РЕДАКТИРОВАТЬ 2: (я думаю) оптимизированная версия хвостового вызова, потому что!

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

   goto &construct;
}

Я запустил ваш код и обнаружил несколько проблем:

  • Вы не ограничены @elements должным образом.
  • с помощью этой рекурсии вы создаете хеш, который ссылается на себя, а это не то, что вам нужно.
  • в вашем внешнем вызове, второй аргумент constructHash() является строкой, но при рекурсивном вызове внутри вы передаете массив @elements

Попробуй это.

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;

Производит

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

Помните, Perl-хэши не упорядочены.

Другие вопросы по тегам