如何使用MooseX :: Storage將自定義init_arg的[必需]屬性序列化？

Question

我想添加序列化到一個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 

非常感謝您的幫助， 丹尼斯

Answer 1

我寫了我上個月報告的問題的修補程序。 我也添加了一個基本的測試文件來檢查它是否按預期工作。當前分配（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)'); 
}