From 8b4b2b6ced4122a0c3e17f76b5eecdbdcf14fb7e Mon Sep 17 00:00:00 2001 From: Dmitry Latin Date: Fri, 30 May 2014 12:03:20 +0400 Subject: [PATCH 1/8] Add deep nested objects collapse test (fails) --- t/003_basic_w_embedded_objects.t | 308 ++++++++++++++++++++++++++++++- 1 file changed, 307 insertions(+), 1 deletion(-) diff --git a/t/003_basic_w_embedded_objects.t b/t/003_basic_w_embedded_objects.t index 03ef4af..3ebbb16 100644 --- a/t/003_basic_w_embedded_objects.t +++ b/t/003_basic_w_embedded_objects.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 47; +use Test::More tests => 49; use Test::Deep; BEGIN { @@ -46,6 +46,22 @@ ArrayRef and HashRef type handlers. is => 'ro', isa => 'HashRef' ); + + package Qux; + use Moose; + use MooseX::Storage; + + with Storage; + + has foos_aa => ( is => 'ro', isa => 'ArrayRef[ArrayRef[Foo]]' ); + has foos_ah => ( is => 'ro', isa => 'ArrayRef[HashRef[Foo]]' ); + has foos_ha => ( is => 'ro', isa => 'HashRef[ArrayRef[Foo]]' ); + has foos_hh => ( is => 'ro', isa => 'HashRef[HashRef[Foo]]' ); + + has bazs_aa => ( is => 'ro', isa => 'ArrayRef[ArrayRef[Baz]]' ); + has bazs_ah => ( is => 'ro', isa => 'ArrayRef[HashRef[Baz]]' ); + has bazs_ha => ( is => 'ro', isa => 'HashRef[ArrayRef[Baz]]' ); + has bazs_hh => ( is => 'ro', isa => 'HashRef[HashRef[Baz]]' ); } { @@ -138,3 +154,293 @@ ArrayRef and HashRef type handlers. is($baz->bars->{$k}->number, $k, "... got the right number ($k) in the Bar in Baz"); } } + + +{ + my $qux = Qux->new( + foos_aa => [ + map { + [ + map { + Foo->new( bars => + [ map { Bar->new( number => $_ ) } ( 1 .. 10 ) ] + ) + } ( 1 .. 10 ) + ] + } ( 1 .. 10 ) + ], + + foos_ah => [ + map { + { + map { + $_ => Foo->new( bars => + [ map { Bar->new( number => $_ ) } ( 1 .. 10 ) ] + ) + } ( 1 .. 10 ) + } + } ( 1 .. 10 ) + ], + + foos_ha => { + map { + $_ => [ + map { + Foo->new( bars => + [ map { Bar->new( number => $_ ) } ( 1 .. 10 ) ] + ) + } ( 1 .. 10 ) + ] + } ( 1 .. 10 ) + }, + + foos_hh => { + map { + $_ => { + map { + $_ => Foo->new( bars => + [ map { Bar->new( number => $_ ) } ( 1 .. 10 ) ] + ) + } ( 1 .. 10 ) + } + } ( 1 .. 10 ) + }, + + bazs_aa => [ + map { + [ + map { + Baz->new( + bars => { + map { ( $_ => Bar->new( number => $_ ) ) } + ( 1 .. 10 ) + } + ) + } ( 1 .. 10 ) + ] + } ( 1 .. 10 ) + ], + + bazs_ah => [ + map { + { + map { + $_ => Baz->new( + bars => { + map { ( $_ => Bar->new( number => $_ ) ) } + ( 1 .. 10 ) + } + ) + } ( 1 .. 10 ) + } + } ( 1 .. 10 ) + ], + + bazs_ha => { + map { + $_ => [ + map { + Baz->new( + bars => { + map { ( $_ => Bar->new( number => $_ ) ) } + ( 1 .. 10 ) + } + ) + } ( 1 .. 10 ) + ] + } ( 1 .. 10 ) + }, + + bazs_hh => { + map { + $_ => { + map { + $_ => Baz->new( + bars => { + map { ( $_ => Bar->new( number => $_ ) ) } + ( 1 .. 10 ) + } + ) + } ( 1 .. 10 ) + } + } ( 1 .. 10 ) + }, + + ); + isa_ok( $qux, 'Qux' ); + + cmp_deeply( + $qux->pack, + { + __CLASS__ => 'Qux', + foos_aa => [ + map { + [ + map { + { + __CLASS__ => 'Foo', + bars => [ + map { + { + __CLASS__ => 'Bar', + number => $_, + } + } ( 1 .. 10 ) + ], + } + } ( 1 .. 10 ) + ] + } ( 1 .. 10 ) + ], + + foos_ah => [ + map { + { + map { + $_ => { + __CLASS__ => 'Foo', + bars => [ + map { + { + __CLASS__ => 'Bar', + number => $_, + } + } ( 1 .. 10 ) + ], + } + } ( 1 .. 10 ) + } + } ( 1 .. 10 ) + ], + + foos_ha => { + map { + $_ => [ + map { + { + __CLASS__ => 'Foo', + bars => [ + map { + { + __CLASS__ => 'Bar', + number => $_, + } + } ( 1 .. 10 ) + ], + } + } ( 1 .. 10 ) + ] + } ( 1 .. 10 ) + }, + + foos_hh => { + map { + $_ => { + map { + $_ => { + __CLASS__ => 'Foo', + bars => [ + map { + { + __CLASS__ => 'Bar', + number => $_, + } + } ( 1 .. 10 ) + ], + } + } ( 1 .. 10 ) + } + } ( 1 .. 10 ) + }, + + bazs_aa => [ + map { + [ + map { + { + __CLASS__ => 'Baz', + bars => { + map { + ( + $_ => { + __CLASS__ => 'Bar', + number => $_, + } + ) + } ( 1 .. 10 ) + }, + } + } ( 1 .. 10 ) + ] + } ( 1 .. 10 ) + ], + + bazs_ah => [ + map { + { + map { + $_ => { + __CLASS__ => 'Baz', + bars => { + map { + ( + $_ => { + __CLASS__ => 'Bar', + number => $_, + } + ) + } ( 1 .. 10 ) + }, + } + } ( 1 .. 10 ) + } + } ( 1 .. 10 ) + ], + + bazs_ha => { + map { + $_ => [ + map { + { + __CLASS__ => 'Baz', + bars => { + map { + ( + $_ => { + __CLASS__ => 'Bar', + number => $_, + } + ) + } ( 1 .. 10 ) + }, + } + } ( 1 .. 10 ) + ] + } ( 1 .. 10 ) + }, + + bazs_hh => { + map { + $_ => { + map { + $_ => { + __CLASS__ => 'Baz', + bars => { + map { + ( + $_ => { + __CLASS__ => 'Bar', + number => $_, + } + ) + } ( 1 .. 10 ) + }, + } + } ( 1 .. 10 ) + } + } ( 1 .. 10 ) + }, + }, + '... got the right frozen class' + ); +} From a79721b8b83634037fdcb502bd1dfdebed8ed3ab Mon Sep 17 00:00:00 2001 From: Dmitry Latin Date: Fri, 30 May 2014 12:04:41 +0400 Subject: [PATCH 2/8] Fix collapse engine for deep nested test (pass) --- lib/MooseX/Storage/Engine.pm | 30 +++++++++++++++++++++++------- 1 file changed, 23 insertions(+), 7 deletions(-) diff --git a/lib/MooseX/Storage/Engine.pm b/lib/MooseX/Storage/Engine.pm index a3f9b72..740b28c 100644 --- a/lib/MooseX/Storage/Engine.pm +++ b/lib/MooseX/Storage/Engine.pm @@ -209,7 +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 @@ -249,9 +250,12 @@ my %TYPES = ( # other real version. [ map { blessed($_) - ? $OBJECT_HANDLERS{collapse}->($_, @args) - : $_ - } @$array ] + ? $OBJECT_HANDLERS{collapse}->( $_, @args ) + : $TYPES{ ref($_) } + ? $TYPES{ ref($_) }->{collapse}->( $_, @args ) + : $_ + } @$array + ] } }, 'HashRef' => { @@ -270,11 +274,16 @@ my %TYPES = ( # we need to make a copy because # otherwise it will affect the # other real version. + +{ map { - blessed($hash->{$_}) + blessed( $hash->{$_} ) ? ($_ => $OBJECT_HANDLERS{collapse}->($hash->{$_}, @args)) - : ($_ => $hash->{$_}) - } keys %$hash } + : $TYPES{ ref( $hash->{$_} ) } + ? ($_ => $TYPES{ ref( $hash->{$_} ) }->{collapse}->($hash->{$_}, @args)) + : ($_ => $hash->{$_}) + + } keys %$hash + } } }, 'Object' => \%OBJECT_HANDLERS, @@ -288,6 +297,13 @@ my %TYPES = ( #} ); +%TYPES = ( + %TYPES, + 'HASH' => $TYPES{HashRef}, + 'ARRAY' => $TYPES{ArrayRef}, +); + + sub add_custom_type_handler { my ($self, $type_name, %handlers) = @_; (exists $handlers{expand} && exists $handlers{collapse}) From 78152bc4ab2b2510c5c35bb336dd87e0ee670030 Mon Sep 17 00:00:00 2001 From: Dmitry Latin Date: Fri, 30 May 2014 13:24:21 +0400 Subject: [PATCH 3/8] Add deep nested objects expand test (fails) --- t/003_basic_w_embedded_objects.t | 245 +++++++++++++++++++++++++++++-- 1 file changed, 236 insertions(+), 9 deletions(-) diff --git a/t/003_basic_w_embedded_objects.t b/t/003_basic_w_embedded_objects.t index 3ebbb16..e657058 100644 --- a/t/003_basic_w_embedded_objects.t +++ b/t/003_basic_w_embedded_objects.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 49; +use Test::More tests => 58; use Test::Deep; BEGIN { @@ -162,8 +162,10 @@ ArrayRef and HashRef type handlers. map { [ map { - Foo->new( bars => - [ map { Bar->new( number => $_ ) } ( 1 .. 10 ) ] + Foo->new( + bars => [ + map { Bar->new( number => $_ ) } ( 1 .. 10 ) + ] ) } ( 1 .. 10 ) ] @@ -174,8 +176,10 @@ ArrayRef and HashRef type handlers. map { { map { - $_ => Foo->new( bars => - [ map { Bar->new( number => $_ ) } ( 1 .. 10 ) ] + $_ => Foo->new( + bars => [ + map { Bar->new( number => $_ ) } ( 1 .. 10 ) + ] ) } ( 1 .. 10 ) } @@ -186,8 +190,10 @@ ArrayRef and HashRef type handlers. map { $_ => [ map { - Foo->new( bars => - [ map { Bar->new( number => $_ ) } ( 1 .. 10 ) ] + Foo->new( + bars => [ + map { Bar->new( number => $_ ) } ( 1 .. 10 ) + ] ) } ( 1 .. 10 ) ] @@ -198,8 +204,10 @@ ArrayRef and HashRef type handlers. map { $_ => { map { - $_ => Foo->new( bars => - [ map { Bar->new( number => $_ ) } ( 1 .. 10 ) ] + $_ => Foo->new( + bars => [ + map { Bar->new( number => $_ ) } ( 1 .. 10 ) + ] ) } ( 1 .. 10 ) } @@ -444,3 +452,222 @@ ArrayRef and HashRef type handlers. '... got the right frozen class' ); } + +{ + my $qux = Qux->unpack( + { + __CLASS__ => 'Qux', + foos_aa => [ + map { + [ + map { + { + __CLASS__ => 'Foo', + bars => [ + map { + { + __CLASS__ => 'Bar', + number => $_, + } + } ( 1 .. 10 ) + ], + } + } ( 1 .. 10 ) + ] + } ( 1 .. 10 ) + ], + + foos_ah => [ + map { + { + map { + $_ => { + __CLASS__ => 'Foo', + bars => [ + map { + { + __CLASS__ => 'Bar', + number => $_, + } + } ( 1 .. 10 ) + ], + } + } ( 1 .. 10 ) + } + } ( 1 .. 10 ) + ], + + foos_ha => { + map { + $_ => [ + map { + { + __CLASS__ => 'Foo', + bars => [ + map { + { + __CLASS__ => 'Bar', + number => $_, + } + } ( 1 .. 10 ) + ], + } + } ( 1 .. 10 ) + ] + } ( 1 .. 10 ) + }, + + foos_hh => { + map { + $_ => { + map { + $_ => { + __CLASS__ => 'Foo', + bars => [ + map { + { + __CLASS__ => 'Bar', + number => $_, + } + } ( 1 .. 10 ) + ], + } + } ( 1 .. 10 ) + } + } ( 1 .. 10 ) + }, + + bazs_aa => [ + map { + [ + map { + { + __CLASS__ => 'Baz', + bars => { + map { + ( + $_ => { + __CLASS__ => 'Bar', + number => $_, + } + ) + } ( 1 .. 10 ) + }, + } + } ( 1 .. 10 ) + ] + } ( 1 .. 10 ) + ], + + bazs_ah => [ + map { + { + map { + $_ => { + __CLASS__ => 'Baz', + bars => { + map { + ( + $_ => { + __CLASS__ => 'Bar', + number => $_, + } + ) + } ( 1 .. 10 ) + }, + } + } ( 1 .. 10 ) + } + } ( 1 .. 10 ) + ], + + bazs_ha => { + map { + $_ => [ + map { + { + __CLASS__ => 'Baz', + bars => { + map { + ( + $_ => { + __CLASS__ => 'Bar', + number => $_, + } + ) + } ( 1 .. 10 ) + }, + } + } ( 1 .. 10 ) + ] + } ( 1 .. 10 ) + }, + + bazs_hh => { + map { + $_ => { + map { + $_ => { + __CLASS__ => 'Baz', + bars => { + map { + ( + $_ => { + __CLASS__ => 'Bar', + number => $_, + } + ) + } ( 1 .. 10 ) + }, + } + } ( 1 .. 10 ) + } + } ( 1 .. 10 ) + }, + } + ); + isa_ok( $qux, 'Qux' ); + + + my $deep_check_isa; + $deep_check_isa = sub { + my ($what) = @_; + + if ( ref $what eq 'HASH' ) { + subtest 'HASH' => sub { + foreach my $k ( keys %{$what} ) { + $deep_check_isa->( $what->{$k} ); + } + }; + } + elsif ( ref $what eq 'ARRAY' ) { + subtest 'ARRAY' => sub { + foreach my $i ( 1 .. scalar @{$what} ) { + $deep_check_isa->( $what->[ $i - 1 ] ); + } + }; + } + elsif ( ref $what eq 'Foo' ) { + foreach my $i ( 1 .. scalar @{ $what->bars } ) { + isa_ok( $what->bars->[ $i - 1 ], 'Bar' ); + is( $what->bars->[ $i - 1 ]->number, + $i, "... got the right number ($i) in the Bar" ); + } + } + elsif ( ref $what eq 'Baz' ) { + foreach my $k ( keys %{ $what->bars } ) { + isa_ok( $what->bars->{$k}, 'Bar' ); + is( $what->bars->{$k}->number, + $k, "... got the right number ($k) in the Bar" ); + } + } + }; + + for my $test ( + 'foos_aa', 'foos_ah', 'foos_ha', 'foos_hh', + 'bazs_aa', 'bazs_ah', 'bazs_ha', 'bazs_hh', + ) + { + subtest $test => sub { $deep_check_isa->( $qux->$test ) }; + } +} From 31a6dffb9dc625c2ddae96eddd84d2263660386a Mon Sep 17 00:00:00 2001 From: Dmitry Latin Date: Fri, 30 May 2014 13:24:57 +0400 Subject: [PATCH 4/8] Fix expand engine for deep nested test (pass) --- lib/MooseX/Storage/Engine.pm | 28 ++++++++++++++++++++++------ 1 file changed, 22 insertions(+), 6 deletions(-) diff --git a/lib/MooseX/Storage/Engine.pm b/lib/MooseX/Storage/Engine.pm index 740b28c..dc9b6de 100644 --- a/lib/MooseX/Storage/Engine.pm +++ b/lib/MooseX/Storage/Engine.pm @@ -236,9 +236,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{HashRef}->{expand}->( $array->[$i], @args ); + } + } + elsif ( ref( $array->[$i] ) eq 'ARRAY' ) { + $array->[$i] = $TYPES{ArrayRef}->{expand}->( $array->[$i], @args ); + } } $array; }, @@ -262,9 +270,17 @@ 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{HashRef}->{expand}->( $hash->{$k}, @args ); + } + } + elsif ( ref( $hash->{$k} ) eq 'ARRAY' ) { + $hash->{$k} = $TYPES{ArrayRef}->{expand}->( $hash->{$k}, @args ); + } } $hash; }, From 37967cfd0603bc269a76a0f70081e6c2a3877733 Mon Sep 17 00:00:00 2001 From: Karen Etheridge Date: Tue, 5 May 2015 12:40:40 -0700 Subject: [PATCH 5/8] Revert "revert all of PR#7 which attempted to add the ability to pack and unpack deeply nested objects." This reverts commit e6c72a8fd6b9804496a5b3eed5c118ae574f21f1. This re-adds the original code from PR#7. --- lib/MooseX/Storage/Engine.pm | 46 ++- t/003_basic_w_embedded_objects.t | 535 ++++++++++++++++++++++++++++++- 2 files changed, 563 insertions(+), 18 deletions(-) diff --git a/lib/MooseX/Storage/Engine.pm b/lib/MooseX/Storage/Engine.pm index 8d14072..134b539 100644 --- a/lib/MooseX/Storage/Engine.pm +++ b/lib/MooseX/Storage/Engine.pm @@ -213,7 +213,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 @@ -225,23 +226,18 @@ my %TYPES = ( 'Value' => { expand => sub { shift }, collapse => sub { shift } }, 'Bool' => { expand => sub { shift }, collapse => sub { shift } }, # These are the trickier ones, (see notes) - # NOTE: - # Because we are nice guys, we will check - # your ArrayRef and/or HashRef one level - # down and inflate any objects we find. - # But this is where it ends, it is too - # expensive to try and do this any more - # recursively, when it is probably not - # necessary in most of the use cases. - # However, if you need more then this, subtype - # and add a custom handler. 'ArrayRef' => { 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') { + $array->[$i] = exists($array->[$i]{$CLASS_MARKER}) + ? $OBJECT_HANDLERS{expand}->($array->[$i], @args) + : $TYPES{HashRef}{expand}->($array->[$i], @args); + } + elsif (ref($array->[$i]) eq 'ARRAY') { + $array->[$i] = $TYPES{ArrayRef}{expand}->($array->[$i], @args); + } } $array; }, @@ -254,6 +250,8 @@ my %TYPES = ( [ map { blessed($_) ? $OBJECT_HANDLERS{collapse}->($_, @args) + : $TYPES{ref($_)} + ? $TYPES{ref($_)}->{collapse}->($_, @args) : $_ } @$array ] } @@ -262,9 +260,14 @@ 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' ) { + $hash->{$k} = exists($hash->{$k}->{$CLASS_MARKER}) + ? $OBJECT_HANDLERS{expand}->($hash->{$k}, @args) + : $TYPES{HashRef}{expand}->($hash->{$k}, @args); + } + elsif (ref($hash->{$k}) eq 'ARRAY') { + $hash->{$k} = $TYPES{ArrayRef}{expand}->($hash->{$k}, @args); + } } $hash; }, @@ -277,6 +280,8 @@ my %TYPES = ( +{ map { blessed($hash->{$_}) ? ($_ => $OBJECT_HANDLERS{collapse}->($hash->{$_}, @args)) + : $TYPES{ref($hash->{$_})} + ? ($_ => $TYPES{ref($hash->{$_})}{collapse}->($hash->{$_}, @args)) : ($_ => $hash->{$_}) } keys %$hash } } @@ -292,6 +297,13 @@ my %TYPES = ( #} ); +%TYPES = ( + %TYPES, + 'HASH' => $TYPES{HashRef}, + 'ARRAY' => $TYPES{ArrayRef}, +); + + sub add_custom_type_handler { my ($self, $type_name, %handlers) = @_; (exists $handlers{expand} && exists $handlers{collapse}) diff --git a/t/003_basic_w_embedded_objects.t b/t/003_basic_w_embedded_objects.t index 30f5e4c..958b636 100644 --- a/t/003_basic_w_embedded_objects.t +++ b/t/003_basic_w_embedded_objects.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 46; +use Test::More tests => 57; use Test::Deep; =pod @@ -42,6 +42,22 @@ ArrayRef and HashRef type handlers. is => 'ro', isa => 'HashRef[Bar]' ); + + package Qux; + use Moose; + use MooseX::Storage; + + with Storage; + + has foos_aa => ( is => 'ro', isa => 'ArrayRef[ArrayRef[Foo]]' ); + has foos_ah => ( is => 'ro', isa => 'ArrayRef[HashRef[Foo]]' ); + has foos_ha => ( is => 'ro', isa => 'HashRef[ArrayRef[Foo]]' ); + has foos_hh => ( is => 'ro', isa => 'HashRef[HashRef[Foo]]' ); + + has bazs_aa => ( is => 'ro', isa => 'ArrayRef[ArrayRef[Baz]]' ); + has bazs_ah => ( is => 'ro', isa => 'ArrayRef[HashRef[Baz]]' ); + has bazs_ha => ( is => 'ro', isa => 'HashRef[ArrayRef[Baz]]' ); + has bazs_hh => ( is => 'ro', isa => 'HashRef[HashRef[Baz]]' ); } { @@ -133,3 +149,520 @@ ArrayRef and HashRef type handlers. is($baz->bars->{$k}->number, $k, "... got the right number ($k) in the Bar in Baz"); } } + + +{ + my $qux = Qux->new( + foos_aa => [ + map { + [ + map { + Foo->new( + bars => [ + map { Bar->new( number => $_ ) } ( 1 .. 10 ) + ] + ) + } ( 1 .. 10 ) + ] + } ( 1 .. 10 ) + ], + + foos_ah => [ + map { + { + map { + $_ => Foo->new( + bars => [ + map { Bar->new( number => $_ ) } ( 1 .. 10 ) + ] + ) + } ( 1 .. 10 ) + } + } ( 1 .. 10 ) + ], + + foos_ha => { + map { + $_ => [ + map { + Foo->new( + bars => [ + map { Bar->new( number => $_ ) } ( 1 .. 10 ) + ] + ) + } ( 1 .. 10 ) + ] + } ( 1 .. 10 ) + }, + + foos_hh => { + map { + $_ => { + map { + $_ => Foo->new( + bars => [ + map { Bar->new( number => $_ ) } ( 1 .. 10 ) + ] + ) + } ( 1 .. 10 ) + } + } ( 1 .. 10 ) + }, + + bazs_aa => [ + map { + [ + map { + Baz->new( + bars => { + map { ( $_ => Bar->new( number => $_ ) ) } + ( 1 .. 10 ) + } + ) + } ( 1 .. 10 ) + ] + } ( 1 .. 10 ) + ], + + bazs_ah => [ + map { + { + map { + $_ => Baz->new( + bars => { + map { ( $_ => Bar->new( number => $_ ) ) } + ( 1 .. 10 ) + } + ) + } ( 1 .. 10 ) + } + } ( 1 .. 10 ) + ], + + bazs_ha => { + map { + $_ => [ + map { + Baz->new( + bars => { + map { ( $_ => Bar->new( number => $_ ) ) } + ( 1 .. 10 ) + } + ) + } ( 1 .. 10 ) + ] + } ( 1 .. 10 ) + }, + + bazs_hh => { + map { + $_ => { + map { + $_ => Baz->new( + bars => { + map { ( $_ => Bar->new( number => $_ ) ) } + ( 1 .. 10 ) + } + ) + } ( 1 .. 10 ) + } + } ( 1 .. 10 ) + }, + + ); + isa_ok( $qux, 'Qux' ); + + cmp_deeply( + $qux->pack, + { + __CLASS__ => 'Qux', + foos_aa => [ + map { + [ + map { + { + __CLASS__ => 'Foo', + bars => [ + map { + { + __CLASS__ => 'Bar', + number => $_, + } + } ( 1 .. 10 ) + ], + } + } ( 1 .. 10 ) + ] + } ( 1 .. 10 ) + ], + + foos_ah => [ + map { + { + map { + $_ => { + __CLASS__ => 'Foo', + bars => [ + map { + { + __CLASS__ => 'Bar', + number => $_, + } + } ( 1 .. 10 ) + ], + } + } ( 1 .. 10 ) + } + } ( 1 .. 10 ) + ], + + foos_ha => { + map { + $_ => [ + map { + { + __CLASS__ => 'Foo', + bars => [ + map { + { + __CLASS__ => 'Bar', + number => $_, + } + } ( 1 .. 10 ) + ], + } + } ( 1 .. 10 ) + ] + } ( 1 .. 10 ) + }, + + foos_hh => { + map { + $_ => { + map { + $_ => { + __CLASS__ => 'Foo', + bars => [ + map { + { + __CLASS__ => 'Bar', + number => $_, + } + } ( 1 .. 10 ) + ], + } + } ( 1 .. 10 ) + } + } ( 1 .. 10 ) + }, + + bazs_aa => [ + map { + [ + map { + { + __CLASS__ => 'Baz', + bars => { + map { + ( + $_ => { + __CLASS__ => 'Bar', + number => $_, + } + ) + } ( 1 .. 10 ) + }, + } + } ( 1 .. 10 ) + ] + } ( 1 .. 10 ) + ], + + bazs_ah => [ + map { + { + map { + $_ => { + __CLASS__ => 'Baz', + bars => { + map { + ( + $_ => { + __CLASS__ => 'Bar', + number => $_, + } + ) + } ( 1 .. 10 ) + }, + } + } ( 1 .. 10 ) + } + } ( 1 .. 10 ) + ], + + bazs_ha => { + map { + $_ => [ + map { + { + __CLASS__ => 'Baz', + bars => { + map { + ( + $_ => { + __CLASS__ => 'Bar', + number => $_, + } + ) + } ( 1 .. 10 ) + }, + } + } ( 1 .. 10 ) + ] + } ( 1 .. 10 ) + }, + + bazs_hh => { + map { + $_ => { + map { + $_ => { + __CLASS__ => 'Baz', + bars => { + map { + ( + $_ => { + __CLASS__ => 'Bar', + number => $_, + } + ) + } ( 1 .. 10 ) + }, + } + } ( 1 .. 10 ) + } + } ( 1 .. 10 ) + }, + }, + '... got the right frozen class' + ); +} + +{ + my $qux = Qux->unpack( + { + __CLASS__ => 'Qux', + foos_aa => [ + map { + [ + map { + { + __CLASS__ => 'Foo', + bars => [ + map { + { + __CLASS__ => 'Bar', + number => $_, + } + } ( 1 .. 10 ) + ], + } + } ( 1 .. 10 ) + ] + } ( 1 .. 10 ) + ], + + foos_ah => [ + map { + { + map { + $_ => { + __CLASS__ => 'Foo', + bars => [ + map { + { + __CLASS__ => 'Bar', + number => $_, + } + } ( 1 .. 10 ) + ], + } + } ( 1 .. 10 ) + } + } ( 1 .. 10 ) + ], + + foos_ha => { + map { + $_ => [ + map { + { + __CLASS__ => 'Foo', + bars => [ + map { + { + __CLASS__ => 'Bar', + number => $_, + } + } ( 1 .. 10 ) + ], + } + } ( 1 .. 10 ) + ] + } ( 1 .. 10 ) + }, + + foos_hh => { + map { + $_ => { + map { + $_ => { + __CLASS__ => 'Foo', + bars => [ + map { + { + __CLASS__ => 'Bar', + number => $_, + } + } ( 1 .. 10 ) + ], + } + } ( 1 .. 10 ) + } + } ( 1 .. 10 ) + }, + + bazs_aa => [ + map { + [ + map { + { + __CLASS__ => 'Baz', + bars => { + map { + ( + $_ => { + __CLASS__ => 'Bar', + number => $_, + } + ) + } ( 1 .. 10 ) + }, + } + } ( 1 .. 10 ) + ] + } ( 1 .. 10 ) + ], + + bazs_ah => [ + map { + { + map { + $_ => { + __CLASS__ => 'Baz', + bars => { + map { + ( + $_ => { + __CLASS__ => 'Bar', + number => $_, + } + ) + } ( 1 .. 10 ) + }, + } + } ( 1 .. 10 ) + } + } ( 1 .. 10 ) + ], + + bazs_ha => { + map { + $_ => [ + map { + { + __CLASS__ => 'Baz', + bars => { + map { + ( + $_ => { + __CLASS__ => 'Bar', + number => $_, + } + ) + } ( 1 .. 10 ) + }, + } + } ( 1 .. 10 ) + ] + } ( 1 .. 10 ) + }, + + bazs_hh => { + map { + $_ => { + map { + $_ => { + __CLASS__ => 'Baz', + bars => { + map { + ( + $_ => { + __CLASS__ => 'Bar', + number => $_, + } + ) + } ( 1 .. 10 ) + }, + } + } ( 1 .. 10 ) + } + } ( 1 .. 10 ) + }, + } + ); + isa_ok( $qux, 'Qux' ); + + + my $deep_check_isa; + $deep_check_isa = sub { + my ($what) = @_; + + if ( ref $what eq 'HASH' ) { + subtest 'HASH' => sub { + foreach my $k ( keys %{$what} ) { + $deep_check_isa->( $what->{$k} ); + } + }; + } + elsif ( ref $what eq 'ARRAY' ) { + subtest 'ARRAY' => sub { + foreach my $i ( 1 .. scalar @{$what} ) { + $deep_check_isa->( $what->[ $i - 1 ] ); + } + }; + } + elsif ( ref $what eq 'Foo' ) { + foreach my $i ( 1 .. scalar @{ $what->bars } ) { + isa_ok( $what->bars->[ $i - 1 ], 'Bar' ); + is( $what->bars->[ $i - 1 ]->number, + $i, "... got the right number ($i) in the Bar" ); + } + } + elsif ( ref $what eq 'Baz' ) { + foreach my $k ( keys %{ $what->bars } ) { + isa_ok( $what->bars->{$k}, 'Bar' ); + is( $what->bars->{$k}->number, + $k, "... got the right number ($k) in the Bar" ); + } + } + }; + + for my $test ( + 'foos_aa', 'foos_ah', 'foos_ha', 'foos_hh', + 'bazs_aa', 'bazs_ah', 'bazs_ha', 'bazs_hh', + ) + { + subtest $test => sub { $deep_check_isa->( $qux->$test ) }; + } +} From 564c53cd43010f7fb589b81f6fc405472800a246 Mon Sep 17 00:00:00 2001 From: Karen Etheridge Date: Tue, 5 May 2015 12:20:02 -0700 Subject: [PATCH 6/8] fix some object collapse tests -- always check the type handlers first before attempting to call $thing->pack --- lib/MooseX/Storage/Engine.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lib/MooseX/Storage/Engine.pm b/lib/MooseX/Storage/Engine.pm index 134b539..d12c549 100644 --- a/lib/MooseX/Storage/Engine.pm +++ b/lib/MooseX/Storage/Engine.pm @@ -248,10 +248,10 @@ my %TYPES; # otherwise it will affect the # other real version. [ map { - blessed($_) - ? $OBJECT_HANDLERS{collapse}->($_, @args) - : $TYPES{ref($_)} + $TYPES{ref($_)} ? $TYPES{ref($_)}->{collapse}->($_, @args) + : blessed($_) + ? $OBJECT_HANDLERS{collapse}->($_, @args) : $_ } @$array ] } From 5d797c349f461dc67c1615baeee3020ccb7df0f5 Mon Sep 17 00:00:00 2001 From: Dmitry Latin Date: Wed, 6 May 2015 01:05:09 +0300 Subject: [PATCH 7/8] Fix merge issues --- lib/MooseX/Storage/Engine.pm | 23 ----------------------- 1 file changed, 23 deletions(-) diff --git a/lib/MooseX/Storage/Engine.pm b/lib/MooseX/Storage/Engine.pm index 0ea859c..10a133a 100644 --- a/lib/MooseX/Storage/Engine.pm +++ b/lib/MooseX/Storage/Engine.pm @@ -238,14 +238,6 @@ my %TYPES; elsif (ref($array->[$i]) eq 'ARRAY') { $array->[$i] = $TYPES{ArrayRef}{expand}->($array->[$i], @args); } - } - else { - $array->[$i] = $TYPES{HashRef}->{expand}->( $array->[$i], @args ); - } - } - elsif ( ref( $array->[$i] ) eq 'ARRAY' ) { - $array->[$i] = $TYPES{ArrayRef}->{expand}->( $array->[$i], @args ); - } } $array; }, @@ -279,14 +271,6 @@ my %TYPES; elsif (ref($hash->{$k}) eq 'ARRAY') { $hash->{$k} = $TYPES{ArrayRef}{expand}->($hash->{$k}, @args); } - } - else { - $hash->{$k} = $TYPES{HashRef}->{expand}->( $hash->{$k}, @args ); - } - } - elsif ( ref( $hash->{$k} ) eq 'ARRAY' ) { - $hash->{$k} = $TYPES{ArrayRef}->{expand}->( $hash->{$k}, @args ); - } } $hash; }, @@ -326,13 +310,6 @@ my %TYPES; ); -%TYPES = ( - %TYPES, - 'HASH' => $TYPES{HashRef}, - 'ARRAY' => $TYPES{ArrayRef}, -); - - sub add_custom_type_handler { my ($self, $type_name, %handlers) = @_; (exists $handlers{expand} && exists $handlers{collapse}) From 7e73099cbaa629df3f2c31f1db77d7ed18e697ab Mon Sep 17 00:00:00 2001 From: Dmitry Latin Date: Wed, 6 May 2015 01:08:01 +0300 Subject: [PATCH 8/8] Prefer $TYPES vs $OBJECT_HANDLERS expand/collapse --- lib/MooseX/Storage/Engine.pm | 28 +++++++++++++--------------- t/080_basic_json_boolean.t | 36 +++++++++++++++++++++++++++--------- 2 files changed, 40 insertions(+), 24 deletions(-) diff --git a/lib/MooseX/Storage/Engine.pm b/lib/MooseX/Storage/Engine.pm index 10a133a..41ade8b 100644 --- a/lib/MooseX/Storage/Engine.pm +++ b/lib/MooseX/Storage/Engine.pm @@ -232,7 +232,9 @@ my %TYPES; foreach my $i (0 .. $#{$array}) { if (ref($array->[$i]) eq 'HASH') { $array->[$i] = exists($array->[$i]{$CLASS_MARKER}) - ? $OBJECT_HANDLERS{expand}->($array->[$i], @args) + ? $TYPES{ $array->[$i]{$CLASS_MARKER} } + ? $TYPES{ $array->[$i]{$CLASS_MARKER} }{expand}->($array->[$i], @args) + : $OBJECT_HANDLERS{expand}->($array->[$i], @args) : $TYPES{HashRef}{expand}->($array->[$i], @args); } elsif (ref($array->[$i]) eq 'ARRAY') { @@ -251,12 +253,9 @@ my %TYPES; $TYPES{ref($_)} ? $TYPES{ref($_)}->{collapse}->($_, @args) : blessed($_) - ? $OBJECT_HANDLERS{collapse}->( $_, @args ) - : $TYPES{ ref($_) } - ? $TYPES{ ref($_) }->{collapse}->( $_, @args ) - : $_ - } @$array - ] + ? $OBJECT_HANDLERS{collapse}->($_, @args) + : $_ + } @$array ] } }, 'HashRef' => { @@ -265,7 +264,9 @@ my %TYPES; foreach my $k (keys %$hash) { if (ref($hash->{$k}) eq 'HASH' ) { $hash->{$k} = exists($hash->{$k}->{$CLASS_MARKER}) - ? $OBJECT_HANDLERS{expand}->($hash->{$k}, @args) + ? $TYPES{ $hash->{$k}->{$CLASS_MARKER} } + ? $TYPES{ $hash->{$k}->{$CLASS_MARKER} }{expand}->($hash->{$k}, @args) + : $OBJECT_HANDLERS{expand}->($hash->{$k}, @args) : $TYPES{HashRef}{expand}->($hash->{$k}, @args); } elsif (ref($hash->{$k}) eq 'ARRAY') { @@ -280,16 +281,13 @@ my %TYPES; # we need to make a copy because # otherwise it will affect the # other real version. - +{ map { - blessed( $hash->{$_} ) - ? ($_ => $OBJECT_HANDLERS{collapse}->($hash->{$_}, @args)) - : $TYPES{ref($hash->{$_})} + $TYPES{ref($hash->{$_})} ? ($_ => $TYPES{ref($hash->{$_})}{collapse}->($hash->{$_}, @args)) + : blessed($hash->{$_}) + ? ($_ => $OBJECT_HANDLERS{collapse}->($hash->{$_}, @args)) : ($_ => $hash->{$_}) - - } keys %$hash - } + } keys %$hash } } }, 'Object' => \%OBJECT_HANDLERS, diff --git a/t/080_basic_json_boolean.t b/t/080_basic_json_boolean.t index e8ff86b..80517f8 100644 --- a/t/080_basic_json_boolean.t +++ b/t/080_basic_json_boolean.t @@ -11,14 +11,14 @@ use MooseX::Storage::Engine; MooseX::Storage::Engine->add_custom_type_handler( 'JSON::PP::Boolean' => ( - expand => sub { $_[0] ? JSON::PP::true : JSON::PP::false }, - collapse => sub { "$_[0]" }, + expand => sub { $_[0]{__value} ? JSON::PP::true : JSON::PP::false }, + collapse => sub { { __CLASS__ => 'JSON::PP::Boolean', __value => "$_[0]" } }, ) ); # support for this was tentatively added in v0.49, but there were unwanted # side effects, and the tests in this file do not pass even with those changes. -local $TODO = 'ability to pack/unpack nested objects is not quite functional'; +#local $TODO = 'ability to pack/unpack nested objects is not quite functional'; { package Foo; @@ -36,12 +36,18 @@ local $TODO = 'ability to pack/unpack nested objects is not quite functional'; is => 'ro', isa => 'ArrayRef[JSON::PP::Boolean]' ); + + has 'hash_bools' => ( + is => 'ro', + isa => 'HashRef[JSON::PP::Boolean]' + ); } { my $foo = Foo->new( one_bool => JSON::PP::true, many_bools => [ JSON::PP::false, JSON::PP::true ], + hash_bools => { true => JSON::PP::true, false => JSON::PP::false }, ); isa_ok($foo, 'Foo'); @@ -57,8 +63,9 @@ local $TODO = 'ability to pack/unpack nested objects is not quite functional'; $pack_result, { __CLASS__ => 'Foo', - one_bool => 1, - many_bools => [ 0, 1 ], + one_bool => { __CLASS__ => 'JSON::PP::Boolean', __value => 1 }, + many_bools => [ { __CLASS__ => 'JSON::PP::Boolean', __value => 0 } , { __CLASS__ => 'JSON::PP::Boolean', __value => 1 } ], + hash_bools => { false => { __CLASS__ => 'JSON::PP::Boolean', __value => 0 } , true => { __CLASS__ => 'JSON::PP::Boolean', __value => 1 } }, }, '... got the right frozen structure' ); @@ -71,8 +78,9 @@ local $TODO = 'ability to pack/unpack nested objects is not quite functional'; $foo = Foo->unpack( { __CLASS__ => 'Foo', - one_bool => 1, - many_bools => [ 0, 1 ], + one_bool => { __CLASS__ => 'JSON::PP::Boolean', __value => 1 }, + many_bools => [ { __CLASS__ => 'JSON::PP::Boolean', __value => 0 } , { __CLASS__ => 'JSON::PP::Boolean', __value => 1 } ], + hash_bools => { false => { __CLASS__ => 'JSON::PP::Boolean', __value => 0 } , true => { __CLASS__ => 'JSON::PP::Boolean', __value => 1 } }, }, ) }, @@ -87,14 +95,24 @@ local $TODO = 'ability to pack/unpack nested objects is not quite functional'; 'one_bool attr is correct', ); + cmp_deeply( $foo->many_bools, [ - all(type('JSON::PP::Boolean'), JSON::PP::false), - all(type('JSON::PP::Boolean'), JSON::PP::true), + all(is_type(class_type('JSON::PP::Boolean')), JSON::PP::false), + all(is_type(class_type('JSON::PP::Boolean')), JSON::PP::true), ], 'many_bools attr is correct', ); + + cmp_deeply( + $foo->hash_bools, + { + false => all(is_type(class_type('JSON::PP::Boolean')), JSON::PP::false), + true => all(is_type(class_type('JSON::PP::Boolean')), JSON::PP::true), + }, + 'hash_bools attr is correct', + ); }; }