解析含重复键的类YAML缩进文本为Perl哈希结构

我有一段类YAML的多行缩进文本，其中存在重复键，需要将其解析为Perl哈希，并且把重复键对应的值自动转换为数组。试过Marpa::R2、Parser::MGC、Parse::RecDescent这些现成解析器都没成功，后来参考了Stack Overflow上的答案，现在已经得到带父节点关联的节点数组，但卡在把这些节点转换成目标Perl结构的步骤。

示例输入文件 #

info:
    family: skywalker

    person:
        id: 0
        status: active

        details:
            gender: male

            name:
                first: Anakin
                last: Skywalker

        children: Leia1
        children: Han Solo1

    person:
        id: 58
        status: active

        details:
            gender: female

            name:
                first: Padme
                last: Amidala

        children: Leia2
        children: Han Solo2

期望的Perl结构 #

{
    'info' => {
        'family' => 'skywalker',
        'person' => [
            {
                'id'      => 0,
                'status'  => 'active',
                'details' => {
                    'gender' => 'male',
                    'name'   => {
                        'first' => 'Anakin',
                        'last'  => 'Skywalker'
                    }
                },
                'children' => [ 'Leia1', 'Han Solo1' ],
            },
            {
                'id'      => 58,
                'status'  => 'active',
                'details' => {
                    'gender' => 'female',
                    'name'   => {
                        'first' => 'Padme',
                        'last'  => 'Amidala'
                    }
                },
                'children' => [ 'Leia2', 'Han Solo2' ],
            }
        ]
    }
}

当前代码 #

#!/usr/bin/env perl
use v5.36;
use strict;
use warnings;
use Data::Dumper;

# Node hierarchy
package Node;

sub new ( $class, $depth, $name, $value ) {
    my $self = {
        Name   => $name,
        Value  => $value,
        Depth  => $depth,
        Parent => undef,
    };
    bless $self, $class;
    return $self;
}

# Main program
package main;

sub parse ($data) {
    my @lines = split /\n/, $data;
    my $queue;
    my $root;
    my $current;
    my $previous;

    foreach my $line (@lines) {
        if ( my ( $spaces, $key, $val ) = $line =~ /^(\s*)(\S+):(?:\s(.+))?$/ )
        {
            my $depth = length($spaces) / 4;
            if ( !$root ) {
                $root    = Node->new( $depth, $key, $val );
                $current = $root;
            }
            else {
                $previous = $current;
                $current  = Node->new( $depth, $key, $val );

                if ( $current->{Depth} > $previous->{Depth} ) {
                    $current->{Parent} = $previous;
                }
                elsif ( $current->{Depth} == $previous->{Depth} ) {
                    $current->{Parent} = $previous->{Parent};
                }
                else {
                    my ($previousSibling) =
                      grep { $_->{Depth} == $current->{Depth} } @$queue;
                    $current->{Parent} =
                      $previousSibling ? $previousSibling->{Parent} : undef;
                }
            }
            push @$queue, $current;
        }
    }

    return $queue;
}

# Main
my $data  = do { local $/; <> };
my $nodes = parse($data);

### Turn into hash?
foreach my $node (@$nodes) {
    my $parents = [];
    my $p = $node;
    while ( $p->{Parent} ) {
        unshift @$parents, $p->{Parent}->{Name};
        $p = $p->{Parent};
    }
    # Key: @$parents . $node->{Name}
    # Value: $node->{Value}
}

节点转目标哈希的实现方案 #

替换当前代码中### Turn into hash?之后的部分，改用以下代码即可完成转换：

# 构建目标哈希结构
my $result = {};
# 存储节点到对应哈希/数组元素的映射，方便快速查找父结构
my %node_to_struct;

# 先初始化根节点的结构
foreach my $node (@$nodes) {
    if (!$node->{Parent}) {
        # 根节点如果有值就用值，否则是空哈希
        $result->{$node->{Name}} = defined $node->{Value} ? $node->{Value} : {};
        $node_to_struct{$node} = $result->{$node->{Name}};
        last;
    }
}

# 按节点深度从小到大处理，确保父节点先被处理完成
foreach my $node (sort { $a->{Depth} <=> $b->{Depth} } @$nodes) {
    next if !$node->{Parent}; # 跳过已经处理过的根节点

    my $parent_struct = $node_to_struct{$node->{Parent}};
    my $key = $node->{Name};
    # 当前节点的值：有值则用值，否则是空哈希（因为下面有子节点）
    my $new_val = defined $node->{Value} ? $node->{Value} : {};

    # 处理重复键的情况
    if (exists $parent_struct->{$key}) {
        my $existing = $parent_struct->{$key};
        if (ref $existing eq 'ARRAY') {
            # 已经是数组，直接追加新值
            push @$existing, $new_val;
            $node_to_struct{$node} = $existing->[-1];
        } else {
            # 转成数组，把原有值和新值都放进去
            $parent_struct->{$key} = [ $existing, $new_val ];
            $node_to_struct{$node} = $parent_struct->{$key}->[-1];
        }
    } else {
        # 首次出现该键，直接赋值
        $parent_struct->{$key} = $new_val;
        $node_to_struct{$node} = $parent_struct->{$key};
    }
}

# 打印结果
print Dumper($result);

代码逻辑说明 #

1. 初始化根节点：找到无父节点的根节点，在结果哈希中创建对应键，建立节点到结构的映射；
2. 按深度排序处理：确保父节点先处理完成，子节点能找到正确的父结构位置；
3. 重复键处理：
   • 父结构中无当前键时，直接赋值（有值用值，无值则为空哈希）；
   • 父结构中已有该键时，若当前值不是数组则转为数组，再追加新值；
4. 维护映射关系：每个节点处理后更新映射表，确保后续子节点能定位到正确的父结构元素。

运行修改后的代码，输入示例文本即可得到期望的Perl哈希结构。

内容的提问来源于stack exchange，提问作者h q