Hi,
I have written a more extensive patch to handle unpacking of attributes with custom init_arg
options (either defined or not). I attach the patch file as well as a comprehensive test file. The
rationale is given in the module POD (maybe not the best place).
Though I am not sure about performance penalty, nor whether it is advisable to implement this
solution "as is" in MooseX::Storage::Basic, my opinion is that the provided functionality is useful
(at least to me :-)
I apologize if I do not follow best practices to submit this patch. I would be happy to follow
another route if someone points me in the right direction.
Hope this helps,
Denis
#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 36;
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' );
has 'requ_str' => ( is => 'ro', isa => 'Str',
init_arg => '-requ_str', required => 1 );
has '_priv_str' => ( is => 'ro', isa => 'Str',
init_arg => undef, writer => '_set_priv_str' );
has '_auto_str' => ( is => 'ro', isa => 'Str',
init_arg => undef, builder => '_build_auto_str', lazy => 1 );
has '_dual_str' => ( is => 'ro', isa => 'Str',
init_arg => undef, writer => '_set_dual_str',
builder => '_build_dual_str', lazy => 1 );
has '_skip_str' => ( is => 'ro', isa => 'Str',
init_arg => undef );
sub _build_auto_str {
return 'auto string';
}
sub _build_dual_str {
return 'dual string';
}
}
{
package Bar;
use Moose;
use MooseX::Storage;
extends 'Foo';
has 'child_str' => ( is => 'ro', isa => 'Str',
init_arg => '-child_str' );
}
{
my $packed = {
__CLASS__ => 'Foo',
number => 10,
string => 'foo',
boolean => 1,
float => 10.5,
array => [ 1 .. 10 ],
hash => { map { $_ => undef } ( 1 .. 10 ) },
object => {
__CLASS__ => 'Foo',
number => 2,
requ_str => 'inner required string',
},
union => [ 1, 2, 3 ],
union2 => 'A String',
# exercise interaction between init_arg and other attr properties
requ_str => 'required string',
_priv_str => 'private string',
_auto_str => 'overriden by builder',
_dual_str => 'restored dual string',
_skip_str => 'private string without writer',
};
my $foo = Foo->unpack($packed);
isa_ok( $foo, 'Foo' );
do_common_checks($foo);
my $bar = Bar->unpack( { # exercise inherited attributes
%$packed,
child_str => 'a string in child class'
} );
isa_ok( $bar, 'Bar' );
do_common_checks($bar);
is( $bar->child_str, 'a string in child class', '... got the right string (child)' );
}
sub do_common_checks {
my $foo = shift;
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( $foo->object->requ_str, 'inner required string',
'... got the right string (required 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)' );
is( $foo->requ_str, 'required string', '... got the right string (required)' );
is( $foo->_priv_str, 'private string', '... got the right string (private)' );
is( $foo->_auto_str, 'auto string', '... got the right string (builder)' );
is( $foo->_dual_str, 'restored dual string', '... got the right string (writer/builder)' );
is( $foo->_skip_str, undef, '... skipped private string without writer' );
}
--- 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-03-10 17:56:46.000000000 +0100
@@ -51,8 +51,35 @@
sub _storage_construct_instance {
my ($class, $args, $opts) = @_;
my %i = defined $opts->{'inject'} ? %{ $opts->{'inject'} } : ();
-
- $class->new( %$args, %i );
+
+ my %priv_attrs;
+ for my $arg (keys %$args) {
+
+ # collect private attributes with undef init_arg but defined writer
+ # these will be restored after instance construction
+ my $init_arg = $class->meta->find_attribute_by_name($arg)->init_arg;
+ if (!defined $init_arg) {
+ my $writer = $class->meta->find_attribute_by_name($arg)->writer;
+ if (defined $writer) {
+ $priv_attrs{$writer} = $args->{$arg};
+ delete $args->{$arg};
+ }
+ }
+
+ # replace attribute name by init_arg if defined
+ # this allows call to constructor below to work as expected
+ elsif ($init_arg ne $arg) {
+ $args->{$init_arg} = $args->{$arg};
+ delete $args->{$arg};
+ }
+ }
+
+ # create new instance using public attributes ...
+ # and populate private attributes with corresponding writers
+ my $instance = $class->new( %$args, %i );
+ $instance->$_( $priv_attrs{$_} ) for keys %priv_attrs;
+
+ return $instance;
}
no Moose::Role;
@@ -119,6 +146,71 @@
Providing the C<insert> argument let's you supply additional arguments to
the class' C<new> function, or override ones from the serialized data.
+Attributes with custom constructor parameters (specified with the C<init_arg>
+option) are packed as other attributes but lead to more complex unpacking. The
+current behavior is as follows.
+
+If C<init_arg> has a defined value (e.g., C<-start> for attribute C<start>), the
+custom constructor parameter (C<-start>) is used when restoring the attribute
+(even though it is still packed as C<start>). This is needed to ensure API
+consistency when extending a large module distribution making use of custom
+constructor parameters (e.g., BioPerl classes).
+
+If C<init_arg> is explicitly set to C<undef>, the unpacking behavior depends on
+the value of the C<writer> option. When C<writer> is defined, the corresponding
+method is used to restore the attribute after object creation (thus overriding
+any attribute value possibly provided by C<default> or C<builder> options). This
+is especially useful for lazy attributes that are very expensive to build and
+thus prime candidates for serialization. Here is a use case that illustrates
+this point.
+
+Consider a C<Store> class providing high-level access to an array of hashes. The
+private C<_store> attribute of this class could be defined as:
+
+ has '_store' => (
+ is => 'ro',
+ isa => 'ArrayRef[HashRef[Num]]|ArrayRef', # union required for
+ init_arg => undef, # unpacking empty slots
+ default => sub { [] },
+ writer => '_set_store', # for unserialization
+ );
+
+Now, let's say that populating a C<Store> object requires processing hundreds of
+large files. Ultimately, input data is stored in the object using methods like:
+
+ sub add_coverage {
+ my $self = shift;
+ my $bin = shift;
+ my $tag = shift;
+ return ${$self->_store}[$bin]{$tag} += shift; # weight
+ }
+
+This is typically a preprocessing step that you only want to do once. In
+contrast, accessing the C<Store> object might be needed several times (for
+example with different sets of parameters for statistical analysis of the store
+content). Thanks to the behavior described above, it is very easy to serialize
+an object with such a private C<_store>. While the C<_store> attribute is
+properly initialized on object creation (owing to its C<default> option), it is
+also correctly restored on unpacking (due to its C<writer> option). Further,
+this approach does not violate encapsulation of the private attribute since it
+restores its value through explicitly defined methods.
+
+Finally, for attributes with C<init_arg> set to C<undef> but without a defined
+C<writer>, attribute values are not restored at all (even if actually packed).
+This is the desired behavior for lazy attributes that are cheap to compute from
+other attributes (generally with a C<builder> option). In this case, it is
+probably better (i.e., clearer) to explicitly add the 'DoNotSerialize' trait, as
+below:
+
+ has 'bin_width' => (
+ is => 'ro',
+ isa => 'Num',
+ init_arg => undef,
+ lazy => 1,
+ builder => '_build_bin_width',
+ traits => [ 'DoNotSerialize' ], # will be recomputed on unpacking
+ );
+
=back
=head2 Introspection
