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

Question

I am trying to add serialization to a Moose class that has mandatory attributes using custom init_arg (to prefix the attribute name with a dash for API consistency), and it seems to cause the decompression to fail. I illustrated my example below.

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 reveals that the problem is that init_arg is not taken into account during packaging. Therefore, after irreversible recovery, the init_arg attribute is not restored. See This Extra 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 so much for your help, Denis

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