From: Jos Boumans <jos@dwim.org>
Date: Tue, 23 Jun 2009 21:07:27 +0000 (+0200)
Subject: * fix a bug where if a required constructor argument was not serialized, it was
X-Git-Tag: 0.20~18
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=186d680b4c69cdbe0306d0e891d879d58af661fe;p=gitmo%2FMooseX-Storage.git

* fix a bug where if a required constructor argument was not serialized, it was
  impossible to ->unpack again.
---

diff --git a/lib/MooseX/Storage/Engine.pm b/lib/MooseX/Storage/Engine.pm
index 20247e0..082e04c 100644
--- a/lib/MooseX/Storage/Engine.pm
+++ b/lib/MooseX/Storage/Engine.pm
@@ -134,28 +134,39 @@ sub check_for_cycle_in_expansion {
 
 sub map_attributes {
     my ($self, $method_name, @args) = @_;
-    map { 
-        $self->$method_name($_, @args) 
-    } grep {
+ 
+    # The $self->object check is here to differentiate a ->pack from a 
+    # ->unpack; ->object is only defined for a ->pack
+ 
+    # no checks needed if this is class based (ie, restore)
+    unless( $self->object ) {
+        return map { $self->$method_name($_, @args) }
+            $self->class->meta->get_all_attributes;
+    }
+    
+    # if it's object based, it's a store -- in that case, 
+    # check thoroughly
+    my @rv;
+    my $o = $self->object;
+    for my $attr ( $o->meta->get_all_attributes ) {    
+        
         # Skip our special skip attribute :)
-        !$_->does('MooseX::Storage::Meta::Attribute::Trait::DoNotSerialize') 
-        and     
+        next if $attr->does(
+            'MooseX::Storage::Meta::Attribute::Trait::DoNotSerialize');
+
         # If we're invoked with the 'OnlyWhenBuilt' trait, we should
         # only serialize the attribute if it's already built. So, go ahead
-        # and check if the attribute has a predicate. If so, check if it's set 
-        # and then go ahead and look it up.
-        # The $self->object check is here to differentiate a ->pack from a 
-        # ->unpack; ->object is only defined for a ->pack
-        do { 
-            if( $self->object and my $pred = $_->predicate and
-                $self->object->does('MooseX::Storage::Traits::OnlyWhenBuilt') 
-            ) { 
-                $self->object->$pred ? 1 : 0; 
-            } else {
-                1 
-            } 
-        }  
-    } ($self->object || $self->class)->meta->get_all_attributes;
+        # and check if the attribute has a predicate. If so, check if it's 
+        # set  and then go ahead and look it up.
+        if( $o->does('MooseX::Storage::Traits::OnlyWhenBuilt') and 
+            my $pred = $attr->predicate 
+        ) { 
+            next unless $self->object->$pred; 
+        }         
+        push @rv, $self->$method_name($attr, @args);
+    } 
+
+    return @rv;
 }
 
 ## ------------------------------------------------------------------
diff --git a/t/008_do_not_serialize.t b/t/008_do_not_serialize.t
index bdf2091..adc8e14 100644
--- a/t/008_do_not_serialize.t
+++ b/t/008_do_not_serialize.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 6;
+use Test::More tests => 11;
 use Test::Exception;
 
 BEGIN {
@@ -37,22 +37,60 @@ BEGIN {
     1;
 }
 
-my $foo = Foo->new;
-isa_ok($foo, 'Foo');
-
-is($foo->bar, 'BAR', '... got the value we expected');
-is($foo->baz, 'BAZ', '... got the value we expected');
-is($foo->gorch, 'GORCH', '... got the value we expected');
+{   my $foo = Foo->new;
+    isa_ok($foo, 'Foo');
+    
+    is($foo->bar, 'BAR', '... got the value we expected');
+    is($foo->baz, 'BAZ', '... got the value we expected');
+    is($foo->gorch, 'GORCH', '... got the value we expected');
+    
+    is_deeply(
+        $foo->pack,
+        {
+            __CLASS__ => 'Foo',
+            gorch     => 'GORCH'
+        },
+        '... got the right packed class data'
+    );
+}
 
-is_deeply(
-    $foo->pack,
-    {
-        __CLASS__ => 'Foo',
-        gorch     => 'GORCH'
-    },
-    '... got the right packed class data'
-);
+### more involved test; required attribute that's not serialized
+{   package Bar;
+    use Moose;
+    use MooseX::Storage;
 
+    with Storage;
 
+    has foo => (
+        metaclass   => 'DoNotSerialize',
+        required    => 1,
+        is          => 'rw',
+    );
+    
+    has zot => (
+        default     => sub { $$ },
+        is          => 'rw',
+    );        
+}
 
+{   my $bar = Bar->new( foo => $$ );
+    
+    ok( $bar,                   "New object created" );
+    is( $bar->foo, $$,          "   ->foo => $$" );
+    is( $bar->zot, $$,          "   ->zot => $$" );
+    
+    my $bpack = $bar->pack;
+    is_deeply(
+        $bpack,
+        {   __CLASS__   => 'Bar',
+            zot         => $$,
+        },                      "   Packed correctly" );
+        
+    my $bar2 = Bar->unpack({ %$bpack, foo => $$ });
+    ok( $bar2,                  "   Unpacked correctly by supplying foo => $$"); 
+}        
+            
+        
+        
+