Как сериализовать [обязательный] атрибут с помощью пользовательского init_arg с помощью MooseX::Storage?

Я пытаюсь добавить сериализацию в класс Moose, который имеет обязательные атрибуты, используя настраиваемые init_arg (с префиксом имени атрибута с тире для согласованности 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

Большое спасибо за помощь, Денис


attributes serialization required perl moose
person denis baurain    schedule 01.02.2011    source источник
comment
Скорее всего это ошибка. В настоящее время мы рисуем соломинку на #лося, чтобы увидеть, кто посмотрит на него первым. (Присоединяйтесь!) :)   -  person Ether    schedule 01.02.2011
comment
Спасибо, Эфир. Я не могу исправить MooseX::Storage самостоятельно, но я добавил новый тестовый пример, который показывает, что проблема в init_arg. Должен ли я подавать отчет об ошибке на CPAN или достаточно того, что есть?   -  person denis baurain    schedule 02.02.2011
comment
Отправьте отчет об ошибке вместе с неудачным тестом на CPAN, если вы еще этого не сделали.   -  person perigrin    schedule 09.02.2011
comment
Готово, Перигрин. Извините за задержку.   -  person denis baurain    schedule 15.02.2011

Ответы (1)


arrow_upward
0
arrow_downward

Я написал патч для проблемы, о которой сообщал в прошлом месяце. Я также добавил базовый тестовый файл, чтобы убедиться, что он работает должным образом. Все остальные тесты (даже необязательные) текущего дистрибутива (0.29) по-прежнему проходят. Не уверен насчет влияния на производительность... Надеюсь, это поможет (по крайней мере, мне это поможет :-)

Денис

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)' );
}
person denis baurain    schedule 28.02.2011