| Subject: | Wrong 'pack' with deep nested objects |
Hello!
Problem is that HASH and ARRAY actually can be a deeply nested
structures, and MooseX::Storage::Engine collapses object just up to the
second level (not deeper)
Example.
StorableClass - class, which use MooseX::Storage and with Storage (so
can('pack') for StorableClass instances is true).
f1 - rw field in StorableClass.
...
my $obj = StorableClass->new(
f1 => {
key1 => [
StorableClass->new(f1 => 'value'),
...
],
...
}
);
my $hashref = $obj->pack;
...
So $hashref has blessed value, instead of "plain" collapsed hash.
Of course it can be resolved by adding custom type handler for ArrayRef
and HashRef, but it is better to have it "from the box".
I attached patch which fix it (also it includes simple test).
| Subject: | nested.patch |
diff -rupN MooseX-Storage-0.31/lib/MooseX/Storage/Engine.pm MooseX-Storage-dim0xff/lib/MooseX/Storage/Engine.pm
--- MooseX-Storage-0.31/lib/MooseX/Storage/Engine.pm 2012-02-29 03:22:46.000000000 +0400
+++ MooseX-Storage-dim0xff/lib/MooseX/Storage/Engine.pm 2012-11-16 14:50:31.000000000 +0400
@@ -83,6 +83,7 @@ sub collapse_attribute_value {
if (defined $value && $attr->has_type_constraint) {
my $type_converter = $self->find_type_handler($attr->type_constraint, $value);
+
(defined $type_converter)
|| confess "Cannot convert " . $attr->type_constraint->name;
$value = $type_converter->{collapse}->($value, $options);
@@ -208,8 +209,8 @@ my %OBJECT_HANDLERS = (
},
);
-
-my %TYPES = (
+my %TYPES;
+%TYPES = (
# NOTE:
# we need to make sure that we properly numify the numbers
# before and after them being futzed with, because some of
@@ -234,9 +235,17 @@ my %TYPES = (
expand => sub {
my ( $array, @args ) = @_;
foreach my $i (0 .. $#{$array}) {
- next unless ref($array->[$i]) eq 'HASH'
- && exists $array->[$i]->{$CLASS_MARKER};
- $array->[$i] = $OBJECT_HANDLERS{expand}->($array->[$i], @args);
+ if (ref($array->[$i]) eq 'HASH') {
+ if (exists $array->[$i]->{$CLASS_MARKER}) {
+ $array->[$i] = $OBJECT_HANDLERS{expand}->($array->[$i], @args);
+ }
+ else {
+ $array->[$i] = $TYPES{HASH}->{expand}->($array->[$i], @args)
+ }
+ }
+ elsif (ref($array->[$i]) eq 'ARRAY') {
+ $array->[$i] = $TYPES{ARRAY}->{expand}->($array->[$i], @args)
+ }
}
$array;
},
@@ -249,7 +258,9 @@ my %TYPES = (
[ map {
blessed($_)
? $OBJECT_HANDLERS{collapse}->($_, @args)
- : $_
+ : $TYPES{ ref($_) }
+ ? $TYPES{ ref($_) }->{collapse}->($_, @args)
+ : $_
} @$array ]
}
},
@@ -257,11 +268,19 @@ my %TYPES = (
expand => sub {
my ( $hash, @args ) = @_;
foreach my $k (keys %$hash) {
- next unless ref($hash->{$k}) eq 'HASH'
- && exists $hash->{$k}->{$CLASS_MARKER};
- $hash->{$k} = $OBJECT_HANDLERS{expand}->($hash->{$k}, @args);
+ if (ref($hash->{$k}) eq 'HASH') {
+ if (exists $hash->{$k}->{$CLASS_MARKER}) {
+ $hash->{$k} = $OBJECT_HANDLERS{expand}->($hash->{$k}, @args);
+ }
+ else {
+ $hash->{$k} = $TYPES{HASH}->{expand}->($hash->{$k}, @args)
+ }
+ }
+ elsif (ref($hash->{$k}) eq 'ARRAY') {
+ $hash->{$k} = $TYPES{ARRAY}->{expand}->($hash->{$k}, @args)
+ }
}
- $hash;
+ $hash;
},
collapse => sub {
my ( $hash, @args ) = @_;
@@ -272,7 +291,10 @@ my %TYPES = (
+{ map {
blessed($hash->{$_})
? ($_ => $OBJECT_HANDLERS{collapse}->($hash->{$_}, @args))
- : ($_ => $hash->{$_})
+ : $TYPES{ ref( $hash->{$_} ) }
+ ? ($_ => $TYPES{ ref( $hash->{$_} ) }->{collapse}->($hash->{$_}, @args))
+ : ($_ => $hash->{$_})
+
} keys %$hash }
}
},
@@ -287,6 +309,12 @@ my %TYPES = (
#}
);
+%TYPES = (
+ %TYPES,
+ 'HASH' => $TYPES{HashRef},
+ 'ARRAY' => $TYPES{ArrayRef},
+);
+
sub add_custom_type_handler {
my ($class, $type_name, %handlers) = @_;
(exists $handlers{expand} && exists $handlers{collapse})
@@ -323,7 +351,7 @@ sub find_type_handler {
# the standard set of built-ins
return $TYPES{$type_constraint->name}
if exists $TYPES{$type_constraint->name};
-
+
# the next possibility is they are
# a subtype of the built-in types,
# in which case this will DWIM in
diff -rupN MooseX-Storage-0.31/t/003_basic_deep_nested.t MooseX-Storage-dim0xff/t/003_basic_deep_nested.t
--- MooseX-Storage-0.31/t/003_basic_deep_nested.t 1970-01-01 03:00:00.000000000 +0300
+++ MooseX-Storage-dim0xff/t/003_basic_deep_nested.t 2012-11-16 14:55:57.616757432 +0400
@@ -0,0 +1,79 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Scalar::Util qw(blessed);
+use Test::Exception;
+
+use lib qw(lib);
+
+package StorableClass;
+
+use Moose;
+use MooseX::Storage;
+use MooseX::Types::Moose qw/ArrayRef HashRef/;
+
+use Carp;
+
+use namespace::autoclean;
+
+with( Storage, );
+
+has id => (
+ is => 'rw',
+ default => sub {
+ int( rand(9999) ) . time;
+ },
+);
+
+has hh => (
+ is => 'rw',
+ isa => HashRef,
+);
+
+package main;
+
+
+my $obj = StorableClass->new(
+ hh => {
+ h => { map { $_->id => $_ } @{ get_storables() } },
+ hh => {
+ h => { map { $_->id => $_ } @{ get_storables() } },
+ hh => {
+ h => { map { $_->id => $_ } @{ get_storables() } },
+ hh => {
+ h => { map { $_->id => $_ } @{ get_storables() } },
+ hh => {},
+ a => get_storables(),
+ aa => [ map { [$_] } @{ get_storables() } ],
+ },
+ a => get_storables(),
+ aa => [ map { [$_] } @{ get_storables() } ],
+ },
+ a => get_storables(),
+ aa => [ map { [$_] } @{ get_storables() } ],
+ },
+ a => get_storables(),
+ aa => [ map { [$_] } @{ get_storables() } ],
+ },
+);
+
+is( blessed( $obj->pack->{hh}->{hh}->{hh}->{hh}->{a}->[0] ),
+ undef, 'Storage::Engine => the deepest element is not blessed' );
+
+my $unpacked_obj = StorableClass->unpack($obj->pack);
+
+is_deeply( $obj, $unpacked_obj, 'Storage::Engine => obj == unpacked_obj' );
+is_deeply( $obj->pack, $unpacked_obj->pack,
+ 'Storage::Engine => packed obj == packed unpacked_obj' );
+
+done_testing();
+
+sub get_storables {
+ return [
+ map {
+ StorableClass->new(
+ hh => { map { 'field_' . $_ => $_ } ( 0 .. ( rand(10) + 1 ) ) } ),
+ } ( 0 .. ( rand(5) + 1 ) )
+ ];
+}