* 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 (file)
--- a/lib/MooseX/Storage/Basic.pm
+++ b/lib/MooseX/Storage/Basic.pm
@@ -82,7 +82,14 @@ but the exported C<Storage> function.
 
 =over 4
 
-=item B<pack>
+=item B<pack ([ disable_cycle_check => 1])>
+
+Providing the C<disable_cycle_check> 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<MooseX::Storage::Traits::DisableCycleDetection>.
 
 =item B<unpack ($data [, insert => { key => val, ... } ] )>
 

diff --git a/lib/MooseX/Storage/Engine.pm b/lib/MooseX/Storage/Engine.pm
index 082e04c..7df03a1 100644 (file)
--- 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 (file)
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<MooseX::Storage> implements a primitive check for circular references.
+This check also triggers on simple cases as shown in the Synopsis.
+Providing the C<DisableCycleDetection> 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<disable_cycle_check> in L<MooseX::Storage::Basic>.
+
+See the SYNOPSIS for a nice example that can be easily cargo-culted.
+
+=head1 METHODS
+
+=head2 Introspection
+
+=over 4
+
+=item B<meta>
+
+=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 E<lt>stevan.little@iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007-2008 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+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 (file)
--- 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" );
+}