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

Question

http://codepad.org/8fJG5XaB

Нужна небольшая помощь в создании хеш-ссылок из hashrefs с последним ключом в качестве ссылки на массив.

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

---

Что требуется:

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

Вы можете сравнить это с выводом с клавиатуры. Обратите внимание на тонкую разницу; вместо 'd', являющегося хэш-ссылкой, у которого есть arrayref value, 'd' - это arrayref, а value.

нет.

Answer 1

Я бы предложил Data :: Diver , хотя это немного неловко, так как он хочет всегда создавать скалярные ссылки в конце, а это не то, что мы хотим.Таким образом, я немного обманываю.

Главное здесь - это то, что мы можем сэкономить усилия (в основном на обслуживании), расшифровывая все ключи одновременно и используя цикл while (внутри Data :: Diver).) вместо рекурсии, которая по своей природе более забавна для расшифровки :-) Объедините это с тем фактом, что даже если бы это была рекурсия, она была бы спрятана в хорошем, аккуратном вызове функции, этодвойной выигрыш: -)

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

Надеюсь, что поможет,

ОБНОВЛЕНИЕ : После разговора с tye он предоставил более лаконичный способсделать это.Он по-прежнему использует Data :: Diver , но имеет гораздо более простое встроенное решение.(Его утверждение состоит в том, что в Perl есть ошибка: lvalue subs и push - я не знаю лучше, так что я верю его слову.)

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

Answer 2

Изменение

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

до

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

РЕДАКТИРОВАТЬ: Извините, я был немного медленным на освоение, но я наконец вижу, что не так с моим ответом. Если вам все еще интересно, ваш оригинальный код был очень близок. Несколько твиков заставили его работать:

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

Answer 3

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

Answer 4

Рекурсия не требуется: 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);

Оглядываясь назад на Хинека, я думаю, что мы используем аналогичный подход

---

Или с помощью рекурсии: 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);