Unblessing Perl 对象并为 convert_blessed 构造 TO_JSON 方法

Question

在this answer 中，我找到了一个简单的TO_JSON 方法的推荐，这是将祝福对象序列化为JSON 所必需的。

sub TO_JSON { return { %{ shift() } }; }

谁能详细解释一下它是如何工作的？

我改成：

sub TO_JSON {
        my $self = shift;         # the object itself – blessed ref
        print STDERR Dumper $self;

        my %h = %{ $self };       # Somehow unblesses $self. WHY???
        print STDERR Dumper \%h;  # same as $self, only unblessed

        return { %h };    # Returns a hashref that contains a hash.
        #return \%h;      # Why not this? Works too…
}

很多问题... :( 简单地说，我无法理解 3 行 Perl 代码。;(

我需要TO_JSON，但它会过滤掉：

• 不需要的属性和
• 也未设置属性（例如，对于那些 has_${attr} 谓词返回 false）

这是我的代码——它有效，但我真的不明白为什么 unblessing 有效……

use 5.010;
use warnings;
use Data::Dumper;

package Some;
use Moo;

has $_ => ( is => 'rw', predicate => 1,) for (qw(a1 a2 nn xx));

sub TO_JSON {
    my $self = shift;
    my $href;
    $href->{$_} = $self->$_ for( grep {!/xx/} keys %$self );
    # Same mysterious unblessing. The `keys` automagically filters out
    # “unset” attributes without the need of call of the has_${attr}
    # predicate… WHY?
    return $href;
}

package main;
use JSON;
use Data::Dumper;

my @objs = map { Some->new(a1 => "a1-$_", a2 => "a2-$_", xx=>"xx-$_") } (1..2);
my $data = {arr => \@objs};
#say Dumper $data;
say JSON->new->allow_blessed->convert_blessed->utf8->pretty->encode($data);

编辑：澄清问题：

• %{ $hRef } 解除对 $hRef 的引用（获取引用指向的哈希），但为什么要从 blessed 对象引用 $self 获取普通哈希？
• 换句话说，为什么$self 是一个hashref？
• 我尝试制作像@{$self}{ grep {!/xx/} keys %$self} 这样的哈希切片，但没有成功。因此我创造了那个可怕的TO_JSON。
• 如果$self 是一个hashref，为什么keys %$self 只返回具有值的属性，而不是所有声明的属性（例如nn 也是——参见has）？

Answer 1

sub TO_JSON { return { %{ shift() } }; }
                     | |  |
                     | |  L_ 1. pull first parameter from `@_`
                     | |        (hashref/blessed or not)
                     | |     
                     | L____ 2. dereference hash (returns key/value list)
                     |
                     L______ 3. return hashref assembled out of list

在您的 TO_JSON() 函数中，{ %h } 返回一个浅哈希副本，而 \%h 返回对 %h 的引用（无复制）。

Answer 2

Perl 通过简单地让引用知道它来自哪个包（使用bless）来实现面向对象。知道引用来自 Foo 包意味着方法实际上是该包中定义的函数。

Perl 允许任何类型的引用得到祝福； 不仅仅是哈希引用。祝福哈希引用是很常见的；很多文档都表明正是这样做的； Moose 做到了；但是，可以为数组引用、子例程引用、文件句柄或对标量的引用提供祝福。语法 %{$self} 仅适用于哈希引用（无论是否祝福）。它采用散列引用，并将其作为散列解引用。原始参考可能已被祝福的事实已经丢失。

我需要 TO_JSON，但会过滤掉什么：

• 不需要的属性
• 以及未设置的属性（例如，对于那些 has_${attr} 谓词返回 false。

在 5.20 之前，哈希切片只为您提供值，而不是原始哈希中的键。您需要键和值。

假设您有一个哈希，并且想要过滤掉不在白名单上的 undef 值和键，有几个选项。这是我所拥有的，使用 JSON 模块：

use strict; # well, I used "use v5.18", but I don't know which version of Perl you're using
use warnings;
use JSON;

my $foo = { foo => undef, bar => 'baz', quux => 5 };
my %whitelist = map { $_, 1 } qw{foo bar};

my %bar = map { $_ => $foo->{$_} }
          grep { defined $foo->{$_} && exists $whitelist{$_} }
          keys %$foo;
print to_json(\%bar) . "\n";
# well, I used say() instead of print(), but I don't know which version of Perl you're using

maps 和 greps 不一定漂亮，但这是我能想到的最简单的方法，可以过滤掉不在白名单上的键和没有 undef 值的元素。

你可以使用数组切片：

use strict;
use warnings;
use JSON;

my $foo = { foo => undef, bar => 'baz', quux => 5 };
my @whitelist = qw{foo bar};

my %filtered_on_keys;
@filtered_on_keys{@whitelist} = @$foo{@whitelist};

my %bar = map { $_ => $filtered_on_keys{$_} }
          grep { defined $filtered_on_keys{$_} }
          keys %filtered_on_keys;
print to_json(\%bar) . "\n";

或者如果你喜欢循环：

use strict;
use warnings;
use JSON;

my $foo = { foo => undef, bar => 'baz', quux => 5 };
my %whitelist = map { $_ => 1 } qw{foo bar};

my %bar;
while (my ($key, $value) = each %$foo) {
    if (defined $value && exists $whitelist{$key}) {
       $bar{$key} = $value;
    }
}

print to_json(\%bar) . "\n";

现在似乎是提出 Larry wall 的名言的好时机，“Perl 旨在为您提供多种方式来做任何事情，因此请考虑选择最易读的一种。”

但是，我强调了并非所有对象都是哈希值。从对象获取数据的适当方法是通过它的 getter 函数：

use strict;
use warnings;
use JSON;

my $foo = Foo->new({ foo => undef, bar => 'baz', quux => 5 }); # as an example

my %filtered_on_keys;
@filtered_on_keys{qw{foo bar}} = ($foo->get_foo(), $foo->get_bar());

my %bar = map { $_ => $filtered_on_keys{$_} }
          grep { defined $filtered_on_keys{$_} }
          keys %filtered_on_keys;
print to_json(\%bar) . "\n";