From: Jos Boumans Date: Wed, 24 Jun 2009 14:46:34 +0000 (+0200) Subject: * add feature to disable cycle checking, eitehr via trait or option X-Git-Tag: 0.20~13 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5b7ea1fd5ab5a918f17cc1bc0450ddf22d7e37c6;p=gitmo%2FMooseX-Storage.git * add feature to disable cycle checking, eitehr via trait or option * add docs & tests (including 1 TODO test) --- diff --git a/lib/MooseX/Storage/Basic.pm b/lib/MooseX/Storage/Basic.pm index 686772b..8b74b37 100644 --- a/lib/MooseX/Storage/Basic.pm +++ b/lib/MooseX/Storage/Basic.pm @@ -82,7 +82,14 @@ but the exported C function. =over 4 -=item B +=item B 1])> + +Providing the C argument disables checks for any cyclical +references. The current implementation for this check is rather naive, so if +you know what you are doing, you can bypass this check. + +This trait is applied on a perl-case basis. To set this flag for all objects +that inherit from this role, see L. =item B { key => val, ... } ] )> diff --git a/lib/MooseX/Storage/Engine.pm b/lib/MooseX/Storage/Engine.pm index 082e04c..7df03a1 100644 --- a/lib/MooseX/Storage/Engine.pm +++ b/lib/MooseX/Storage/Engine.pm @@ -42,9 +42,9 @@ sub collapse_object { sub expand_object { my ($self, $data, %options) = @_; - $options{check_version} = 1 unless exists $options{check_version}; - $options{check_authority} = 1 unless exists $options{check_authority}; - + $options{check_version} = 1 unless exists $options{check_version}; + $options{check_authority} = 1 unless exists $options{check_authority}; + # NOTE: # mark the root object as seen ... $self->seen->{refaddr $data} = undef; @@ -78,8 +78,13 @@ sub collapse_attribute_value { # this might not be enough, we might # need to make it possible for the # cycle checker to return the value - $self->check_for_cycle_in_collapse($attr, $value) - if ref $value; + # Check cycles unless explicitly disabled + if( ref $value and not( + $options->{disable_cycle_check} or + $self->object->does('MooseX::Storage::Traits::DisableCycleDetection') + )) { + $self->check_for_cycle_in_collapse($attr, $value) + } if (defined $value && $attr->has_type_constraint) { my $type_converter = $self->find_type_handler($attr->type_constraint); @@ -95,8 +100,12 @@ sub expand_attribute_value { # NOTE: # (see comment in method above ^^) - $self->check_for_cycle_in_expansion($attr, $value) - if ref $value; + if( ref $value and not( + $options->{disable_cycle_check} or + $self->class->does('MooseX::Storage::Traits::DisableCycleDetection') + )) { + $self->check_for_cycle_in_collapse($attr, $value) + } if (defined $value && $attr->has_type_constraint) { my $type_converter = $self->find_type_handler($attr->type_constraint); diff --git a/lib/MooseX/Storage/Traits/DisableCycleDetection.pm b/lib/MooseX/Storage/Traits/DisableCycleDetection.pm new file mode 100644 index 0000000..9d62b00 --- /dev/null +++ b/lib/MooseX/Storage/Traits/DisableCycleDetection.pm @@ -0,0 +1,76 @@ +package MooseX::Storage::Traits::DisableCycleDetection; +use Moose::Role; + +our $VERSION = '0.18'; +our $AUTHORITY = 'cpan:STEVAN'; + +1; + +__END__ + +=pod + +=head1 NAME + +MooseX::Storage::Traits::DisableCycleDetection - A custom trait to bypass cycle detection + +=head1 SYNOPSIS + + + package Double; + use Moose; + use MooseX::Storage; + with Storage( traits => ['DisableCycleDetection'] ); + + has 'x' => ( is => 'rw', isa => 'HashRef' ); + has 'y' => ( is => 'rw', isa => 'HashRef' ); + + my $ref = {}; + + my $double = Double->new( 'x' => $ref, 'y' => $ref ); + + $double->pack; + + +=head1 DESCRIPTION + +C implements a primitive check for circular references. +This check also triggers on simple cases as shown in the Synopsis. +Providing the C traits disables checks for any cyclical +references, so if you know what you are doing, you can bypass this check. + +This trait is applied to all objects that inherit from it. To use this +on a per-case basis, see C in L. + +See the SYNOPSIS for a nice example that can be easily cargo-culted. + +=head1 METHODS + +=head2 Introspection + +=over 4 + +=item B + +=back + +=head1 BUGS + +All complex software has bugs lurking in it, and this module is no +exception. If you find a bug please either email me, or add the bug +to cpan-RT. + +=head1 AUTHOR + +Stevan Little Estevan.little@iinteractive.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2007-2008 by Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/t/004_w_cycles.t b/t/004_w_cycles.t index 92fc210..5e03c9a 100644 --- a/t/004_w_cycles.t +++ b/t/004_w_cycles.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 12; +use Test::More tests => 16; use Test::Exception; BEGIN { @@ -130,4 +130,53 @@ This test demonstrates two things: '... got the right packed version (with parent attribute skipped)'); } +### this fails with cycle detection on +{ package Double; + use Moose; + use MooseX::Storage; + with Storage; + + has 'x' => ( is => 'rw', isa => 'HashRef' ); + has 'y' => ( is => 'rw', isa => 'HashRef' ); +} + +{ my $ref = {}; + + my $double = Double->new( 'x' => $ref, 'y' => $ref ); + + ### currently, the cycle checker's too naive to figure out this is not + ### a problem + TODO: { + local $TODO = "Cycle check is too naive"; + my $pack = eval { $double->pack; }; + ok( $pack, "Object with 2 references packed" ); + ok( Double->unpack( $pack ), + " And unpacked again" ); + } + + my $pack = $double->pack( disable_cycle_check => 1 ); + ok( $pack, " Object packs when cycle check is disabled"); + ok( Double->unpack( $pack ), + " And unpacked again" ); + +} + +### the same as above, but now done with a trait +### this fails with cycle detection on +{ package DoubleNoCycle; + use Moose; + use MooseX::Storage; + with Storage( traits => ['DisableCycleDetection'] ); + + has 'x' => ( is => 'rw', isa => 'HashRef' ); + has 'y' => ( is => 'rw', isa => 'HashRef' ); +} + +{ my $ref = {}; + my $double = DoubleNoCycle->new( 'x' => $ref, 'y' => $ref ); + my $pack = $double->pack; + ok( $pack, "Object packs with DisableCycleDetection trait"); + ok( DoubleNoCycle->unpack( $pack ), + " Unpacked again" ); +}