cycle stuff

diff --git a/lib/MooseX/Storage.pm b/lib/MooseX/Storage.pm
index c28194b..549b15a 100644 (file)
--- a/lib/MooseX/Storage.pm
+++ b/lib/MooseX/Storage.pm
@@ -52,7 +52,7 @@ __END__
 
 =head1 NAME
 
-MooseX::Storage - A persistence framework for Moose classes
+MooseX::Storage - An serialization framework for Moose classes
 
 =head1 SYNOPSIS
 

diff --git a/lib/MooseX/Storage/Engine.pm b/lib/MooseX/Storage/Engine.pm
index 558fb64..dd47f8c 100644 (file)
--- a/lib/MooseX/Storage/Engine.pm
+++ b/lib/MooseX/Storage/Engine.pm
@@ -64,6 +64,10 @@ sub collapse_attribute_value {
     my ($self, $attr)  = @_;
        my $value = $attr->get_value($self->object);
        
+       # NOTE:
+       # 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($value) 
         if ref $value;
        
@@ -79,6 +83,8 @@ sub collapse_attribute_value {
 sub expand_attribute_value {
     my ($self, $attr, $value)  = @_;
 
+       # NOTE:
+       # (see comment in method above ^^)
     $self->check_for_cycle_in_expansion($value) 
         if ref $value;    
     
@@ -89,7 +95,12 @@ sub expand_attribute_value {
        return $value;
 }
 
-# util methods ...
+# NOTE:
+# possibly these two methods will 
+# be used by a cycle supporting 
+# engine. However, I am not sure 
+# if I can make a cycle one work 
+# anyway.
 
 sub check_for_cycle_in_collapse {
     my ($self, $value) = @_;
@@ -105,10 +116,15 @@ sub check_for_cycle_in_expansion {
     $self->seen->{$value} = undef;
 }
 
+# util methods ...
+
 sub map_attributes {
     my ($self, $method_name, @args) = @_;
     map { 
         $self->$method_name($_, @args) 
+    } grep {
+        # Skip our special skip attribute :)
+        !$_->isa('MooseX::Storage::Meta::Attribute::DoNotSerialize')
     } ($self->object || $self->class)->meta->compute_all_applicable_attributes;
 }
 
@@ -289,6 +305,8 @@ MooseX::Storage::Engine
 
 =item B<storage>
 
+=item B<seen>
+
 =back
 
 =head2 API
@@ -313,6 +331,10 @@ MooseX::Storage::Engine
 
 =item B<expand_attribute_value>
 
+=item B<check_for_cycle_in_collapse>
+
+=item B<check_for_cycle_in_expansion>
+
 =item B<map_attributes>
 
 =back

diff --git a/lib/MooseX/Storage/Meta/Attribute/DoNotSerialize.pm b/lib/MooseX/Storage/Meta/Attribute/DoNotSerialize.pm
new file mode 100644 (file)
index 0000000..e7b3ad3
--- /dev/null
+++ b/lib/MooseX/Storage/Meta/Attribute/DoNotSerialize.pm
@@ -0,0 +1,52 @@
+
+package MooseX::Storage::Meta::Attribute::DoNotSerialize;
+use Moose;
+
+extends 'Moose::Meta::Attribute';
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+MooseX::Storage::Meta::Attribute::DoNotSerialize
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=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
+
+Chris Prather E<lt>chris.prather@iinteractive.comE<gt>
+
+Stevan Little E<lt>stevan.little@iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007 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 d08c9ae..3cb3a0b 100644 (file)
--- a/t/004_w_cycles.t
+++ b/t/004_w_cycles.t
@@ -10,6 +10,16 @@ BEGIN {
     use_ok('MooseX::Storage');
 }
 
+=pod
+
+This test demonstrates two things:
+
+- cycles will not work in the default engine
+- you can use a special metaclass to tell 
+  MooseX::Storage to skip an attribute
+
+=cut
+
 {
 
     package Circular;
@@ -43,5 +53,81 @@ BEGIN {
     '... cannot expand a cycle with the basic engine';
 }
 
+{
+
+    package Tree;
+    use Moose;
+    use MooseX::Storage;
+
+    with Storage;
+
+    has 'node' => (is => 'rw');
+    
+    has 'children' => (
+        is      => 'ro', 
+        isa     => 'ArrayRef', 
+        default => sub {[]}
+    );
+    
+    has 'parent' => (
+        metaclass => 'MooseX::Storage::Meta::Attribute::DoNotSerialize',
+        is        => 'rw', 
+        isa       => 'Tree',
+    );
+    
+    sub add_child {
+        my ($self, $child) = @_;
+        $child->parent($self);
+        push @{$self->children} => $child;
+    }
+}
+
+{
+    my $t = Tree->new(node => 100);
+    isa_ok($t, 'Tree');
+    
+    is_deeply(
+        $t->pack, 
+        {
+            __CLASS__ => 'Tree',
+            node      => 100,
+            children  => [],
+        },
+    '... got the right packed version');
+    
+    my $t2 = Tree->new(node => 200);
+    isa_ok($t2, 'Tree');    
+    
+    $t->add_child($t2);
+    
+    is_deeply($t->children, [ $t2 ], '... got the right children in $t');
+    
+    is($t2->parent, $t, '... created the cycle correctly');
+    isa_ok($t2->parent, 'Tree');        
+    
+    is_deeply(
+        $t->pack, 
+        {
+            __CLASS__ => 'Tree',
+            node      => 100,
+            children  => [
+               {
+                   __CLASS__ => 'Tree',
+                   node      => 200,
+                   children  => [],            
+               } 
+            ],
+        },
+    '... got the right packed version (with parent attribute skipped in child)');    
+    
+    is_deeply(
+        $t2->pack, 
+        {
+            __CLASS__ => 'Tree',
+            node      => 200,
+            children  => [],            
+        },
+    '... got the right packed version (with parent attribute skipped)');
+}