Question

需要一些帮助来创建hashrefs的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的hashref，'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

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 3

改变

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

在回顾Hynek之后，我认为我们正在使用类似的方法

或使用递归：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);

Perl：创建哈希哈希，最后一个键作为对数组的引用

想要什么：

4 个答案:

无需递归：http://codepad.org/XsMCDW2y

或使用递归：http://codepad.org/xVPuCO1N