在 perl 中创建深度哈希映射

Question

下面是我的哈希代码

#!/usr/bin/perl
use warnings;
use JSON::PP; # Just 'use JSON;' on most systems
my %name = (
          'sl' => {
                    'fsd' => {
                               'conf' => {
                                           'ul' => '/sl/fsd/conf/ul',
                                           'si' => '/sl/fsd/conf/si',
                                           'ho1' => '/sl/fsd/conf/ho1'
                                         }
                             }
                  },
          're' => {
                    'fsd' => {
                               'cron' => {
                                           'README' => '/re/fsd/cron/README'
                                         },
                               'bin' => {
                                          'db' => {
                                                    'smart.p_add_tag' => '/re/fsd/bin/db/smart.p_add_tag',
                                                    'smart.p_tag_partition' => '/re/fsd/bin/db/smart.p_tag_partition',
                                                    'smart.p_add_tag_type' => '/re/fsd/bin/db/smart.p_add_tag_type'
                                                  }
                                        },
                               'doc' => {
                                          'SMART' => '/re/fsd/doc/SMART',
                                          'README' => '/re/fsd/doc/README'
                                        },
                               'data' => {
                                           'README' => '/re/fsd/data/README'
                                         },
                               'conf' => {
                                           'al1' => '/re/fsd/conf/al1',
                                           'file' => '/re/fsd/conf/file',
                                           'ho' => '/re/fsd/conf/ho',
                                           'al3' => '/re/fsd/conf/al3',
                                           'hst' => '/re/fsd/conf/hst',
                                           'us' => '/re/fsd/conf/us',
                                           'README' => '/re/fsd/conf/README',
                                           'al2' => '/re/fsd/conf/al2'
                                         }
                             }
                  }
        );




(my $root) = keys %name;

my %nodes = ();
my %tree  = ();
my @queue = ($root);

list_children(\%name, \@queue, \%nodes) while @queue;

my $tree = build_tree($root, \%nodes);

my $json = JSON::PP->new->pretty; # prettify for human consumption

print $json->encode($tree);

sub list_children {
  my $adjac = shift;
  my $queue  = shift;
  my $nodes  = shift;

  my $node = shift @$queue;

  my @children = keys %{$adjac->{$node}};

  @children = grep { ! exists $nodes->{$_}} @children;

  $nodes->{$node} = \@children;

  push @$queue, @children;
}

sub build_tree {
  my $root  = shift;
  my $nodes = shift;

  my @children;
  for my $child (@{$nodes->{$root}}) {
    push @children, build_tree($child, $nodes);
  }

  my %h = ('text'     => $root,
           'children' => \@children);

  return \%h;
}

我正在尝试输出 JSONified 哈希，但它最多只能遍历两个级别。而我需要它遍历所有父节点的最后一个子节点。有人可以帮助实现这一目标吗？

下面是电流输出

{
   "text" : "sl",
   "children" : [
      {
         "text" : "fsd",
         "children" : []
      }
   ]
}

Answer 1

通常，转换散列，然后 然后 json-ing 不是最有效的想法，因为您将进行一次遍历来转换散列，而 JSON 将进行一次遍历到 json-化它，JSON 是哈希的一种转换。

但是，JSON 通常是用 XS 完成的，这意味着至少第二次遍历更快。那和 JSON 行为是标准化的。

use 5.016;
use strict;
use warnings;
use Data::Dumper ();
use JSON;

my $hash
    =  {
  'Foods' => {
    'fruits' => {
      'orange' => '1',
      'apple' => '2',
    },
    'Vegetables' => {
      'tomato' => '3',
      'carrot' => '1',
      'cabbage' => '2',
    }
  }
};

sub descend { 
    my ( $structure, $block ) = @_;
    my $res;
    while ( my ( $k, $v ) = each %$structure ) { 
        $block->( $structure, $k, $v );
        if ( ref( $v ) eq 'HASH' ) { 
            $res = descend( $v, $block );
        }
    }
    return $res;
}

my $new  = {};
my $curr = $new;

descend( $hash => sub { 
    my ( $lvl, $k, $v ) = @_;
    my $node = { text => $k };
    $curr->{children} //= [];
    push $curr->{children}, $node;

    if ( ref( $v ) eq 'HASH' ) { 
        $curr = $node;
    }
    else { 
        $node->{children} = { text => $v };
    }
});

# allow for the root-level special case, and retrieve the first child. 
$new = $new->{children}[0];

say Data::Dumper->Dump( [ $new ], [ '$new' ] );
say JSON->new->encode( $new );