3

http://codepad.org/8fJG5XaB

配列への参照として最後のキーを使用して、hashrefのhashrefを作成するのに少し助けが必要です。

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 
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 に答える
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 に答える
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を振り返った後、私たちは同様のアプローチを使用していると思います

または再帰を使用する：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 に答える