3

http://codepad.org/8fJG5XaB

需要一点帮助来创建 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 的 hashref value， 'd' 是 arrayref 并且没有value.

4

4 回答 4

2

我建议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);
于 2011-10-12T21:56:46.410 回答
1

改变

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);
于 2011-10-12T23:17:02.873 回答
1 
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
于 2011-10-12T22:15:53.807 回答
0

无需递归：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's 之后，我认为我们正在使用类似的方法

或使用递归：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);
于 2011-10-12T22:54:00.603 回答