From: Stevan Little Date: Tue, 3 Apr 2007 18:14:22 +0000 (+0000) Subject: implemented cycle handling X-Git-Tag: 0_02~22 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7eb5dc635e43005020528128b012527cb5707559;hp=ba5bba75ba0c4f8af075e95ce3b00e5376bedf5c;p=gitmo%2FMooseX-Storage.git implemented cycle handling --- diff --git a/lib/MooseX/Storage/Engine.pm b/lib/MooseX/Storage/Engine.pm index 7f3bbb4..558fb64 100644 --- a/lib/MooseX/Storage/Engine.pm +++ b/lib/MooseX/Storage/Engine.pm @@ -9,7 +9,13 @@ our $VERSION = '0.01'; our $CLASS_MARKER = '__CLASS__'; has 'storage' => ( - is => 'rw', + is => 'ro', + isa => 'HashRef', + default => sub {{}} +); + +has 'seen' => ( + is => 'ro', isa => 'HashRef', default => sub {{}} ); @@ -21,6 +27,11 @@ has 'class' => (is => 'rw', isa => 'Str'); sub collapse_object { my $self = shift; + + # NOTE: + # mark the root object as seen ... + $self->seen->{$self->object} = undef; + $self->map_attributes('collapse_attribute'); $self->storage->{$CLASS_MARKER} = $self->object->meta->name; return $self->storage; @@ -28,6 +39,11 @@ sub collapse_object { sub expand_object { my ($self, $data) = @_; + + # NOTE: + # mark the root object as seen ... + $self->seen->{$data} = undef; + $self->map_attributes('expand_attribute', $data); return $self->storage; } @@ -47,6 +63,10 @@ sub expand_attribute { sub collapse_attribute_value { my ($self, $attr) = @_; my $value = $attr->get_value($self->object); + + $self->check_for_cycle_in_collapse($value) + if ref $value; + if (defined $value && $attr->has_type_constraint) { my $type_converter = $self->find_type_handler($attr->type_constraint); (defined $type_converter) @@ -58,6 +78,10 @@ sub collapse_attribute_value { sub expand_attribute_value { my ($self, $attr, $value) = @_; + + $self->check_for_cycle_in_expansion($value) + if ref $value; + if (defined $value && $attr->has_type_constraint) { my $type_converter = $self->find_type_handler($attr->type_constraint); $value = $type_converter->{expand}->($value); @@ -67,6 +91,20 @@ sub expand_attribute_value { # util methods ... +sub check_for_cycle_in_collapse { + my ($self, $value) = @_; + (!exists $self->seen->{$value}) + || confess "Basic Engine does not support cycles"; + $self->seen->{$value} = undef; +} + +sub check_for_cycle_in_expansion { + my ($self, $value) = @_; + (!exists $self->seen->{$value}) + || confess "Basic Engine does not support cycles"; + $self->seen->{$value} = undef; +} + sub map_attributes { my ($self, $method_name, @args) = @_; map { @@ -170,7 +208,7 @@ my %TYPES = ( #'CodeRef' => { # expand => sub {}, # use eval ... # collapse => sub {}, # use B::Deparse ... - #} + #} ); sub add_custom_type_handler { diff --git a/t/004_w_cycles.t b/t/004_w_cycles.t new file mode 100644 index 0000000..d08c9ae --- /dev/null +++ b/t/004_w_cycles.t @@ -0,0 +1,47 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More no_plan => 1; +use Test::Exception; + +BEGIN { + use_ok('MooseX::Storage'); +} + +{ + + package Circular; + use Moose; + use MooseX::Storage; + + with Storage; + + has 'cycle' => (is => 'rw', isa => 'Circular'); +} + +{ + my $circular = Circular->new; + isa_ok($circular, 'Circular'); + + $circular->cycle($circular); + + throws_ok { + $circular->pack; + } qr/^Basic Engine does not support cycles/, + '... cannot collapse a cycle with the basic engine'; +} + +{ + my $packed_circular = { __CLASS__ => 'Circular' }; + $packed_circular->{cycle} = $packed_circular; + + throws_ok { + Circular->unpack($packed_circular); + } qr/^Basic Engine does not support cycles/, + '... cannot expand a cycle with the basic engine'; +} + + +