使用fetchrow_hashref将Perl组结果存储在哈希表中

Question

我希望按照下面的数据通过countryid对结果进行分组。

my @test = ();
my $st   = qq[
    SELECT id,countryID,abbrev
    FROM myTable
];
my $q = $data->prepare($st);
$q->execute() or query_error($st);
while ( my $result = $q->fetchrow_hashref ) {
    push @test, $result;
}

使用fetchrow_hashref，我在显示结果方面没有任何问题。

use Data::Dumper;
print STDERR Dumper(\@test);

返回值

$VAR1 = [
    {   'id'        => '1',
        'countryID' => '1',
        'title'     => 'Title 1',
        'abbrev'    => 't1'
    },
    {   'id'        => '2',
        'countryID' => '2',
        'title'     => 'Title 2',
        'abbrev'    => 't2'
    },
    {   'id'        => '3',
        'countryID' => '3',
        'title'     => 'Title 3',
        'abbrev'    => 't3'
    },
    {   'id'        => '4',
        'countryID' => '1',
        'title'     => 'Title 4',
        'abbrev'    => 't4'
    }
];

我希望你能按国家进行分组，如下所示。

$VAR1 = [
    'countries' => {
        '1' => [
            {   'id'     => '1',
                'title'  => 'Title 1',
                'abbrev' => 't1'
            },
            {   'id'     => '4',
                'title'  => 'Title 4',
                'abbrev' => 't4'
            }
        ],
        '2' => [
            {   'id'     => '2',
                'title'  => 'Title 2',
                'abbrev' => 't2'
            }
        ],
        '3' => [
            {   'id'     => '3',
                'title'  => 'Title 3',
                'abbrev' => 't3'
            }
        ]
    }
];

如何让这个在while循环中工作？

- ak85

Answer 1

忽略样本数据结构中的错误，你基本上是想将哈希表数组转换为哈希表数组的哈希表。一旦你设置好了初始数据结构，你可以按照以下步骤创建新的嵌套数据结构：

for my $href ( @test ) {
    my $id = $href->{countryID};
    delete $href->{countryID};
    push @{ $test2->{countries}{$id} }, $href;
}

遍历您的数组@ test中的每个元素，它基本上是一组哈希引用。创建一个变量$ id，它将捕获哈希中的countryID值。我们从哈希引用中删除它，然后将该哈希引用分配给我们的新嵌套数据结构，该数据结构以countries作为第一级键，以$id作为第二级键。

我们使用push语法来创建这些引用的数组。

注意：正如评论中thb所述，这确实会破坏您的原始数据结构。如果要保留原始结构，请将代码修改为以下内容：

for my $href ( @test ) {
    my $copy = { %$href };
    my $id   = $copy->{countryID};
    delete $copy->{countryID};
    push @{ $test2->{countries}{$id} }, $copy;
}

- jaypal singh

---

你的答案很好，但我想提一点小建议：除了填充%$test2之外，你的代码是否无意中损坏了@test？如果是这样，也许应该指出来。 - thb

感谢@thb的反馈。我已将您的评论添加到答案中，并提出了一种替代方案以避免该问题。 - jaypal singh

Answer 2

像这样，输入/输出数据结构可能不完全符合您的要求，您可以进行修改。

use strict;
use Data::Dumper;

$a = [
    {   'id'        => '1',
        'countryID' => '1',
        'title'     => 'Title 1',
        'abbrev'    => 't1'
    },
    {   'id'        => '2',
        'countryID' => '2',
        'title'     => 'Title 2',
        'abbrev'    => 't2'
    },
    {   'id'        => '3',
        'countryID' => '3',
        'title'     => 'Title 3',
        'abbrev'    => 't3'
    },
    {   'id'        => '4',
        'countryID' => '1',
        'title'     => 'Title 4',
        'abbrev'    => 't4'
    }
];

my $b = {};

for my $item (@$a) {
    if ( exists( $b->{ $item->{'countryID'} } ) ) {
        push( @{ $b->{ $item->{'countryID'} } }, $item );
    } else {
        $b->{ $item->{'countryID'} } = [$item];
    }
}
print Dumper($b);

上面的代码输出如下：

$VAR1 = {
    '1' => [
        {   'abbrev'    => 't1',
            'title'     => 'Title 1',
            'id'        => '1',
            'countryID' => '1'
        },
        {   'abbrev'    => 't4',
            'title'     => 'Title 4',
            'id'        => '4',
            'countryID' => '1'
        }
    ],
    '3' => [
        {   'abbrev'    => 't3',
            'title'     => 'Title 3',
            'id'        => '3',
            'countryID' => '3'
        }
    ],
    '2' => [
        {   'abbrev'    => 't2',
            'title'     => 'Title 2',
            'id'        => '2',
            'countryID' => '2'
        }
    ]
};

- Peter Pei Guo

Answer 3

您需要稍微修正上面的语法（例如=>而不是= >），但是一旦您完成了这个步骤，像这样的内容应该可以很好地工作。

for (@$VAR1_orig) {
    my %a = %$_;
    my $countryID = $a{countryID};
    delete $a{countryID};
    push @{$VAR1->{countries}{$countryID}}, \%a;
}

(I have tried it on my computer, by the way. It works.)

以上假设%$VAR1最初为空，然后根据@$VAR1_orig填充它，之后您可以对$VAR1进行任何操作。 （我假设您知道Perl中%$和@$的含义，但这不是入门级话题，可能您已经知道。请参阅man 1 perlref。）

- thb