How to serialize a [required] attribute with a custom init_arg using MooseX::Storage?

Question

I'm trying to add serialization to a Moose class that has required attributes using custom init_arg's (to prefix the attribute name with a dash for API consistency) and it seems that this causes unpacking to fail. I've setup a test case below to illustrate my point.

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 ...

Update: further investigation indicates that the issue is that init_arg is not taken into account when packing. Hence, even a non-required attribute using a custom init_arg is not correctly restored after unpacking. See this additional test case:

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

Thanks a lot for your help, Denis

Answer 1

I've written a patch for the issue I reported last month. I've also added a basic test file to check it works as expected. All other tests (even optional) of the current distribution (0.29) still pass. Not sure about the impact on performance though... Hope this helps (this helps me at least :-)

Denis

PS: I submit it as well on rt.cpan.org.

The patch is as is:

--- 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 );
 }

The test file is there (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)' );
}