不兼容的Perl对象并为convert_blessed构造TO_JSON方法

Question

在这个答案中,我找到了一个简单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)

这是我的代码 - 它有效,但我真的不明白为什么不成功的工作......

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 }derefences的$hRef(获得哈希指向的参考),但为什么从获得的纯哈希祝福对象的引用 $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通过简单地使引用可以知道它来自哪个包(with bless)来实现面向对象.知道来自Foo包的引用意味着方法实际上是在该包中定义的函数.

Perl允许任何类型的引用得到祝福; 不只是哈希引用.保佑哈希引用是很常见的; 很多文档都说明了这一点; 并且Moose做到了; 但是,可以祝福数组引用,子程序引用,文件句柄或标量引用.语法%{$self}仅适用于哈希引用(祝福或不祝福).它接受哈希引用,并将其解引用为哈希.原始参考可能已被祝福的事实已经丢失.

我需要TO_JSON,但会过滤掉什么:

• 不需要的属性
• 和unset属性(例如,对于那些_ $ {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";

这似乎是提起拉里墙的一句话的好时机,"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";