From: Cory Watson Date: Tue, 9 Mar 2010 17:30:17 +0000 (-0600) Subject: Use feature in Moose 0.99 to allow serialization of union types. X-Git-Tag: 0.25~2 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d7ef03f6e65591eec83471f6887f5928451c494a;p=gitmo%2FMooseX-Storage.git Use feature in Moose 0.99 to allow serialization of union types. --- diff --git a/Makefile.PL b/Makefile.PL index 6012e73..8c672a9 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -8,7 +8,7 @@ name 'MooseX-Storage'; all_from 'lib/MooseX/Storage.pm'; # Specific dependencies -requires 'Moose' => '0.87'; +requires 'Moose' => '0.99'; requires 'String::RewritePrefix'; author_requires 'Test::Without::Module'; diff --git a/lib/MooseX/Storage/Engine.pm b/lib/MooseX/Storage/Engine.pm index ce2cb74..1441dcc 100644 --- a/lib/MooseX/Storage/Engine.pm +++ b/lib/MooseX/Storage/Engine.pm @@ -82,7 +82,7 @@ sub collapse_attribute_value { if ref $value; if (defined $value && $attr->has_type_constraint) { - my $type_converter = $self->find_type_handler($attr->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); @@ -103,7 +103,7 @@ sub expand_attribute_value { } if (defined $value && $attr->has_type_constraint) { - my $type_converter = $self->find_type_handler($attr->type_constraint); + my $type_converter = $self->find_type_handler($attr->type_constraint, $value); $value = $type_converter->{expand}->($value, $options); } return $value; @@ -300,16 +300,24 @@ sub remove_custom_type_handler { } sub find_type_handler { - my ($self, $type_constraint) = @_; - + my ($self, $type_constraint, $value) = @_; + # check if the type is a Maybe and # if its parent is not parameterized. # If both is true recurse this method # using ->type_parameter. - return $self->find_type_handler($type_constraint->type_parameter) + return $self->find_type_handler($type_constraint->type_parameter, $value) if ($type_constraint->parent && $type_constraint->parent eq 'Maybe' and not $type_constraint->parent->can('type_parameter')); + # find_type_for is a method of a union type. If we can call that method + # then we are dealign with a union and we need to ascertain which of + # the union's types we need to use for the value we are serializing. + if($type_constraint->can('find_type_for')) { + my $tc = $type_constraint->find_type_for($value); + return $self->find_type_handler($tc, $value) if defined($tc); + } + # this should handle most type usages # since they they are usually just # the standard set of built-ins diff --git a/t/001_basic.t b/t/001_basic.t index fcb591a..faf41eb 100644 --- a/t/001_basic.t +++ b/t/001_basic.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 12; +use Test::More tests => 14; BEGIN { use_ok('MooseX::Storage'); @@ -24,6 +24,8 @@ BEGIN { has 'array' => ( is => 'ro', isa => 'ArrayRef' ); has 'hash' => ( is => 'ro', isa => 'HashRef' ); has 'object' => ( is => 'ro', isa => 'Foo' ); + has 'union' => ( is => 'ro', isa => 'ArrayRef|Str' ); + has 'union2' => ( is => 'ro', isa => 'ArrayRef|Str' ); } { @@ -35,9 +37,11 @@ BEGIN { array => [ 1 .. 10 ], hash => { map { $_ => undef } ( 1 .. 10 ) }, object => Foo->new( number => 2 ), + union => [ 1, 2, 3 ], + union2 => 'A String' ); isa_ok( $foo, 'Foo' ); - + is_deeply( $foo->pack, { @@ -48,10 +52,12 @@ BEGIN { float => 10.5, array => [ 1 .. 10 ], hash => { map { $_ => undef } ( 1 .. 10 ) }, - object => { - __CLASS__ => 'Foo', - number => 2 - }, + object => { + __CLASS__ => 'Foo', + number => 2 + }, + union => [ 1, 2, 3 ], + union2 => 'A String' }, '... got the right frozen class' ); @@ -67,11 +73,13 @@ BEGIN { float => 10.5, array => [ 1 .. 10 ], hash => { map { $_ => undef } ( 1 .. 10 ) }, - object => { - __CLASS__ => 'Foo', - number => 2 - }, - } + object => { + __CLASS__ => 'Foo', + number => 2 + }, + union => [ 1, 2, 3 ], + union2 => 'A String' + } ); isa_ok( $foo, 'Foo' ); @@ -89,4 +97,6 @@ BEGIN { 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)' ); }