Как я могу объединить несколько хешей в один хеш в Perl?

Предполагая, что вышеуказанные данные находятся в файле dump.txt, вы можете оценить их по частям.

Обновленный код ниже

use strict;
use File::Slurp;
my $final_data = {}; 
my @data = map {eval $_} (read_file("dump.txt") =~ /\$VAR1 = ([^;]+);/gs);
foreach my $element (@data) {
    my $key = (keys %$element)[0]; 
    $final_data->{$key} ||= []; 
    push @{$final_data->{$key}}, $element->{$key}
}; 
use Data::Dumper; 
print Data::Dumper->Dump([$final_data]);

Если вы хотите полностью выполнить глубокое слияние, вы можете в конце передать $final_data через это (не проверено!!!) глубокое слияние:

# Merge an array of hashes as follows:
# IN:  [ { 1 => 11 }, { 1 => 12 },{ 2 => 22 } ]
# OUT: { 1 => [ 11, 12 ], 2 => [ 22 ] }
# This is recursive - if array [11,12] was an array of hashrefs, we merge those too
sub merge_hashes {
    my $hashes = @_[0];
    return $hashes unless ref $hashes eq ref []; # Hat tip to brian d foy
    return $hashes unless grep { ref @_ eq ref {} } @$hashes; # Only merge array of hashes
    my $final_hashref = {};
    foreach my $element (@$hashes) {
        foreach my $key (keys %$element) {
            $final_hashref->{$key} ||= [];
            push @{ $final_hashref->{$key} }, $element->{$key};
        }
    }
    foreach my $key (keys %$final_hashref) {
        $final_hashref->{$key} = merge_hashes($final_hashref->{$key});
    }
    return $final_hashref;
}

Попробуйте это рекурсивное решение:

#   XXX: doesn't handle circular problems...
sub deepmerge {
    my (@structs) = @_;
    my $new;

    # filter out non-existant structs
    @structs = grep {defined($_)} @structs;

    my $ref = ref($structs[0]);
    if (not all(map {ref($_) eq $ref} @structs)) { 
        warn("deepmerge: all structs are not $ref\n");
    } 

    my @tomerge = grep {ref($_) eq $ref} @structs;
    return qr/$tomerge[0]/ if scalar(@tomerge) == 1 and $ref eq 'Regexp';
    return $tomerge[0] if scalar(@tomerge) == 1;

    if ($ref eq '') { 
        $new = pop(@tomerge); # prefer farthest right
    } 
    elsif ($ref eq 'Regexp') { 
        $new = qr/$tomerge[$#tomerge]/;
    } 
    elsif ($ref eq 'ARRAY') { 
        $new = [];
        for my $i (0 .. max(map {scalar(@$_) - 1} @tomerge)) { 
            $new->[$i] = deepmerge(map {$_->[$i]} @tomerge);
        }
    } 
    elsif ($ref eq 'HASH') { 
        $new = {};
        for my $key (uniq(map {keys %$_} @tomerge)) { 
            $new->{$key} = deepmerge(map {$_->{$key}} @tomerge);
        }
    }
    else {
        # ignore all other structures...
        $new = '';
    }

    return $new;
}

Измените его, чтобы ваше сердце довольствуется достижением желаемого результата.

При дальнейшем исследовании я заметил, что вы объединяете их другим способом, нежели приведенный выше алгоритм. Может быть, тогда просто возьмем это как пример. Моя делает это:

deepmerge({k => 'v'}, {k2 => 'v2'});
# returns {k => 'v', k2 => 'v2'}

И подобные вещи для массивов.

Используйте push и автовивификацию.

Начните с обычного вступительного сообщения:

#! /usr/bin/perl

use warnings;
use strict;

Прочтите образец ввода из дескриптора файла DATA и создайте структуру данных, аналогичную той, которую вы сбросили:

my @hashes;
while (<DATA>) {
  my $VAR1;
  $VAR1 = eval $_;
  die $@ if $@;
  push @hashes => $VAR1;
}

Ваш ввод имеет два случая:

1. Ссылка на массив, содержащий данные, которые должны быть объединены со своими родственниками, имеющими тот же «ключевой путь».
2. В противном случае это ссылка на хэш, который содержит ссылку на массив из варианта 1 на некоторой глубине, поэтому мы снимите самый верхний слой и продолжайте копать.

Обратите внимание на использование $ _ [0] . Семантика подпрограмм Perl такова, что значения в @_ являются псевдонимами , а не копиями. Это позволяет нам напрямую вызывать merge без необходимости сначала создавать связку скаффолдинга для хранения объединенного содержимого. Код сломается, если вместо этого вы скопируете значение.

sub merge {
  my $data = shift;

  if (ref($data) eq "ARRAY") {
    push @{ $_[0] } => @$data;
  }
  else {
    foreach my $k (%$data) {
      merge($data->{$k} => $_[0]{$k});
    }
  }
}

Теперь мы проходим @hashes и постепенно объединяем их содержимое в % merged .

my %merged;    
foreach my $h (@hashes) {
  foreach my $k (keys %$h) {
    merge $h->{$k} => $merged{$k};
  }
}

Мы не знаем, в каком порядке пришли значения, поэтому запустите заключительный проход очистки, чтобы отсортировать массивы:

sub sort_arrays {
  my($root) = @_;
  if (ref($root) eq "ARRAY") {
    @$root = sort { $a <=> $b } @$root;
  }
  else {
    sort_arrays($root->{$_}) for keys %$root;
  }
}

sort_arrays \%merged;

Модуль Data :: Dumper отлично подходит для быстрой отладки!

use Data::Dumper;
$Data::Dumper::Indent = 1;
print Dumper \%merged;

Поместите копию ввода из вашего вопроса в специальный дескриптор файла DATA :

__DATA__
$VAR1 = { '999' => { '998' => [ '908', '906', '0', '998', '907' ] } };
$VAR1 = { '999' => { '991' => [ '913', '920', '918', '998', '916', '919', '917', '915', '912', '914' ] } };
$VAR1 = { '999' => { '996' => [] } };
$VAR1 = { '999' => { '995' => [] } };
$VAR1 = { '999' => { '994' => [] } };
$VAR1 = { '999' => { '993' => [] } };
$VAR1 = { '999' => { '997' => [ '986', '987', '990', '984', '989', '988' ] } };
$VAR1 = { '995' => { '101' => [] } };
$VAR1 = { '995' => { '102' => [] } };
$VAR1 = { '995' => { '103' => [] } };
$VAR1 = { '995' => { '104' => [] } };
$VAR1 = { '995' => { '105' => [] } };
$VAR1 = { '995' => { '106' => [] } };
$VAR1 = { '995' => { '107' => [] } };
$VAR1 = { '994' => { '910' => [] } };
$VAR1 = { '993' => { '909' => [] } };
$VAR1 = { '993' => { '904' => [] } };
$VAR1 = { '994' => { '985' => [] } };
$VAR1 = { '994' => { '983' => [] } };
$VAR1 = { '993' => { '902' => [] } };
$VAR1 = { '999' => { '992' => [ '905' ] } };

Пример вывода приведен ниже:

  '994' => {
    '910' => [],
    '985' => [],
    '983' => []
  },
  '999' => {
    '993' => [],
    '992' => [
      '905'
    ],
    '997' => [
      '984',
      '986',
      '987',
      '988',
      '989',
      '990'
    ],

Используйте CPAN! Попробуйте Hash :: Merge

# OO interface.  
my $merge = Hash::Merge->new( 'LEFT_PRECEDENT' );
my %c = %{ $merge->merge( \%a, \%b ) };

См. CPAN для получения дополнительной информации, он в значительной степени делает все, что вы хотите, и полностью настраивается.

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

$VAR1 = { '999:' => [
                      { '992' => [ '905' ] },
                      { '993' => [
                                   { '909' => [] },
                                   { '904' => [] },
                                   { '902' => [] }
                                 ]
                      },
                      { '994' => [
                                   { '910' => [] },
                                   { '985' => [] },
                                   { '983' => [] }
                                 ]
                      },
                      { '995' => [
                                   { '101' => [] },
                                   { '102' => [] },
                                   { '103' => [] },
                                   { '104' => [] },
                                   { '105' => [] },
                                   { '106' => [] },
                                   { '107' => [] }
                                 ]
                      },
                      { '996' => [] },
                      { '997' => [ '986', '987', '990', '984', '989', '988' ] },
                      { '998' => [ '908', '906', '0', '998', '907' ] },
                      { '991' => [ '913', '920', '918', '998', '916', '919', '917', '915', '912', '914' ] }
                    ]
        };

Однако я не вижу смысла во всех этих хэшах с одной записью, не будет ли лучше следующее?

$VAR1 = { '999:' => {
                      '992' => [ '905' ],
                      '993' => {
                                 '909' => [],
                                 '904' => [],
                                 '902' => []
                               },
                      '994' => {
                                 '910' => [],
                                 '985' => [],
                                 '983' => []
                               },
                      '995' => {
                                 '101' => [],
                                 '102' => [],
                                 '103' => [],
                                 '104' => [],
                                 '105' => [],
                                 '106' => [],
                                 '107' => []
                               },
                      '996' => [],
                      '997' => [ '986', '987', '990', '984', '989', '988' ],
                      '998' => [ '908', '906', '0', '998', '907' ],
                      '991' => [ '913', '920', '918', '998', '916', '919', '917', '915', '912', '914' ]
                    }
        };

вау. Большое спасибо всем (особенно Axeman)! извините за отсутствие кода или разъяснений, я пытался сгенерировать дерево и попробовал Hash :: Merge, но не смог, хоть убей, решить проблему придуманной 995 замены пустого 995 непустым 995 ; Решение Axeman прекрасно работает, и я очень ценю помощь / сотрудничество! (также пробовал другие, и он либо делал то же самое, что и Hash :: Merge, либо фактически избавлялся от некоторых ветвей).

некоторая предыстория входных данных: имелся набор хэшей, у каждого из которых были ключи (все на одном уровне), и два из которых определяли а) родителя другого и б) самого себя (остальные были дочерними), и так с tree, я решил, что хеш идеален, придумал набор новых хешей {a} -> {b} -> [c], и вот мы ...

снова, спасибо всем и Axeman!