如何使用 MooseX::Storage 使用自定义 init_arg 序列化 [required] 属性？

Question

我正在尝试使用自定义 init_arg 向具有所需属性的 Moose 类添加序列化（在属性名称前添加破折号以确保 API 一致性），这似乎会导致解包失败。我在下面设置了一个测试用例来说明我的观点。

use strict;
use warnings;


package MyClass1;

use Moose;
use MooseX::Storage;
use namespace::autoclean;

with Storage;

has 'my_attr' => (
    is       => 'ro',
    isa      => 'Str',
    required => 1,
);

__PACKAGE__->meta->make_immutable;


package MyClass2;

use Moose;
use MooseX::Storage;
use namespace::autoclean;

with Storage;

has 'my_attr' => (
    is       => 'ro',
    isa      => 'Str',
    required => 1,
    init_arg => '-my_attr',
);

__PACKAGE__->meta->make_immutable;


package main;

my $inst1 = MyClass1->new(my_attr => 'The String');
my $packed1 = $inst1->pack;
my $unpacked1 = MyClass1->unpack($packed1);     # this works

my $inst2 = MyClass2->new(-my_attr => 'The String');
my $packed2 = $inst2->pack;
my $unpacked2 = MyClass2->unpack($packed2);     # this fails with a ...
    # ... Attribute (my_attr) is required at ...

更新：进一步调查表明问题在于打包时未考虑 init_arg。因此，即使使用自定义 init_arg 的非必需属性在解包后也无法正确恢复。请参阅此附加测试用例：

package MyClass3;

with Storage;

has 'my_attr' => (
    is       => 'ro',
    isa      => 'Str',
    init_arg => '-my_attr',
);

# in main...

my $inst3 = MyClass3->new(-my_attr => 'The String');
my $packed3 = $inst3->pack;
my $unpacked3 = MyClass3->unpack($packed3);     # this seems to work ...
say $unpacked3->my_attr;                        # ... but my_attr stays undef

非常感谢您的帮助， 丹尼斯

Answer 1

我已经为上个月报告的问题编写了一个补丁。
我还添加了一个基本测试文件来检查它是否按预期工作。当前分布 (0.29) 的所有其他测试（甚至是可选的）仍然通过。但不确定对性能的影响...希望这会有所帮助（这至少对我有帮助:-)

Denis

PS：我也在 rt.cpan.org 上提交了它。

补丁如下：

--- MooseX-Storage-0.29/lib/MooseX/Storage/Basic.pm 2010-11-17 14:51:35.000000000 +0100
+++ MooseX-Storage-0.29f/lib/MooseX/Storage/Basic.pm    2011-02-28 11:49:54.000000000 +0100
@@ -52,6 +52,15 @@
     my ($class, $args, $opts) = @_;
     my %i = defined $opts->{'inject'} ? %{ $opts->{'inject'} } : ();

+    # handle attributes with custom init_arg definitions
+    for my $arg (keys %$args) {
+        my $init_arg = $class->meta->get_attribute($arg)->init_arg;
+        if (defined $init_arg && $init_arg ne $arg) {
+            $args->{$init_arg} = $args->{$arg};
+            delete $args->{$arg};
+        }       # replace attribute name by its init_arg if defined
+    }           # this allows call to constructor below to work as expected
+
     $class->new( %$args, %i );
 }

测试文件在那里（t/080​​_basic_initarg.t）：

#!/usr/bin/perl

use strict;
use warnings;

use Test::More tests => 12;

BEGIN {
    use_ok('MooseX::Storage');
}

{

    package Foo;
    use Moose;
    use MooseX::Storage;

    with Storage;

    has 'number'  => ( is => 'ro', isa => 'Int',
        init_arg => '-number' );
    has 'string'  => ( is => 'ro', isa => 'Str',
        init_arg => '-string' );
    has 'boolean' => ( is => 'ro', isa => 'Bool',
        init_arg => '-boolean' );
    has 'float'   => ( is => 'ro', isa => 'Num',
        init_arg => '-float' );
    has 'array'   => ( is => 'ro', isa => 'ArrayRef',
        init_arg => '-array' );
    has 'hash'    => ( is => 'ro', isa => 'HashRef',
        init_arg => '-hash' );
    has 'object'  => ( is => 'ro', isa => 'Foo',
        init_arg => '-object' );
    has 'union'   => ( is => 'ro', isa => 'ArrayRef|Str',
        init_arg => '-union' );
    has 'union2'  => ( is => 'ro', isa => 'ArrayRef|Str',
        init_arg => '-union2' );
}

{
    my $foo = Foo->unpack(
        {
            __CLASS__ => 'Foo',
            number    => 10,
            string    => 'foo',
            boolean   => 1,
            float     => 10.5,
            array     => [ 1 .. 10 ],
            hash      => { map { $_ => undef } ( 1 .. 10 ) },
            object    => {
                            __CLASS__ => 'Foo',
                            number    => 2
                         },
            union     => [ 1, 2, 3 ],
            union2    => 'A String'
        }
    );
    isa_ok( $foo, 'Foo' );

    is( $foo->number, 10,    '... got the right number' );
    is( $foo->string, 'foo', '... got the right string' );
    ok( $foo->boolean,       '... got the right boolean' );
    is( $foo->float,  10.5,  '... got the right float' );
    is_deeply( $foo->array, [ 1 .. 10 ], '... got the right array' );
    is_deeply(
        $foo->hash,
        { map { $_ => undef } ( 1 .. 10 ) },
        '... got the right hash'
    );

    isa_ok( $foo->object, 'Foo' );
    is( $foo->object->number, 2,
        '... got the right number (in the embedded object)' );
    is_deeply( $foo->union, [ 1 .. 3 ], '... got the right array (in the union)' );
    is( $foo->union2,  'A String',  '... got the right string (in the union)' );
}