swithc to Data::Dumper

diff --git a/lib/MooseX/Storage/Base/WithChecksum.pm b/lib/MooseX/Storage/Base/WithChecksum.pm
index 227c447..496ca72 100644 (file)
--- a/lib/MooseX/Storage/Base/WithChecksum.pm
+++ b/lib/MooseX/Storage/Base/WithChecksum.pm
@@ -3,9 +3,11 @@ package MooseX::Storage::Base::WithChecksum;
 use Moose::Role;
 
 use Digest ();
-use Storable ();
+#use Storable ();
 use MooseX::Storage::Engine;
 
+use Data::Dumper ();
+
 our $VERSION = '0.01';
 
 our $DIGEST_MARKER = '__DIGEST__';
@@ -27,8 +29,7 @@ sub unpack {
 
     # check checksum on data
     
-    my $old_checksum = $data->{$DIGEST_MARKER};
-    delete $data->{$DIGEST_MARKER};
+    my $old_checksum = delete $data->{$DIGEST_MARKER};
     
     my $checksum = $class->_digest_packed($data, @args);
 
@@ -48,7 +49,11 @@ sub _digest_packed {
 
     {
         local $Storable::canonical = 1;
-        $d->add( Storable::nfreeze($collapsed) );
+        local $Data::Dumper::Indent = 0;
+        local $Data::Dumper::Sortkeys = 1;
+
+        #Storable::nfreeze($collapsed);
+        $d->add( Data::Dumper::Dumper($collapsed) );
     }
 
     return $d->hexdigest;

diff --git a/lib/MooseX/Storage/Engine.pm b/lib/MooseX/Storage/Engine.pm
index 1177469..49e5664 100644 (file)
--- a/lib/MooseX/Storage/Engine.pm
+++ b/lib/MooseX/Storage/Engine.pm
@@ -26,13 +26,13 @@ has 'class'  => (is => 'rw', isa => 'Str');
 ## this is the API used by other modules ...
 
 sub collapse_object {
-    my ( $self, @args ) = @_;
+    my ( $self, %options ) = @_;
 
        # NOTE:
        # mark the root object as seen ...
        $self->seen->{$self->object} = undef;
        
-    $self->map_attributes('collapse_attribute');
+    $self->map_attributes('collapse_attribute', \%options);
     $self->storage->{$CLASS_MARKER} = $self->object->meta->identifier;    
        return $self->storage;
 }
@@ -54,8 +54,8 @@ sub expand_object {
 ## this is the internal API ...
 
 sub collapse_attribute {
-    my ($self, $attr)  = @_;
-    $self->storage->{$attr->name} = $self->collapse_attribute_value($attr) || return;
+    my ($self, $attr, @args)  = @_;
+    $self->storage->{$attr->name} = $self->collapse_attribute_value($attr, @args) || return;
 }
 
 sub expand_attribute {
@@ -64,21 +64,21 @@ sub expand_attribute {
 }
 
 sub collapse_attribute_value {
-    my ($self, $attr)  = @_;
+    my ($self, $attr, @args)  = @_;
        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($attr, $value) 
+    $self->check_for_cycle_in_collapse($attr, $value)
         if ref $value;
        
     if (defined $value && $attr->has_type_constraint) {
         my $type_converter = $self->find_type_handler($attr->type_constraint);
         (defined $type_converter)
             || confess "Cannot convert " . $attr->type_constraint->name;
-        $value = $type_converter->{collapse}->($value);
+        $value = $type_converter->{collapse}->($value, @args);
     }
        return $value;
 }
@@ -185,13 +185,13 @@ my %OBJECT_HANDLERS = (
         }
             
         # all is well ...
-        $class->unpack($data);
+        $class->unpack($data, %$options);
     },
     collapse => sub {
-        my $obj = shift;
+        my ( $obj, $options ) = @_;
 #        ($obj->can('does') && $obj->does('MooseX::Storage::Basic'))
 #            || confess "Bad object ($obj) does not do MooseX::Storage::Basic role";
-        $obj->pack();
+        $obj->pack(%$options);
     },
 );
 
@@ -214,46 +214,46 @@ my %TYPES = (
     # and add a custom handler.    
     'ArrayRef' => { 
         expand => sub {
-            my $array = shift;
+            my ( $array, @args ) = @_;
             foreach my $i (0 .. $#{$array}) {
                 next unless ref($array->[$i]) eq 'HASH' 
                          && exists $array->[$i]->{$CLASS_MARKER};
-                $array->[$i] = $OBJECT_HANDLERS{expand}->($array->[$i])
+                $array->[$i] = $OBJECT_HANDLERS{expand}->($array->[$i], @args);
             }
             $array;
         }, 
-        collapse => sub { 
-            my $array = shift;   
+        collapse => sub {
+            my ( $array, @args ) = @_;
             # NOTE:         
             # we need to make a copy cause
             # otherwise it will affect the 
             # other real version.
             [ map {
                 blessed($_)
-                    ? $OBJECT_HANDLERS{collapse}->($_)
+                    ? $OBJECT_HANDLERS{collapse}->($_, @args)
                     : $_
             } @$array ] 
         } 
     },
     'HashRef'  => { 
         expand   => sub {
-            my $hash = shift;
+            my ( $hash, @args ) = @_;
             foreach my $k (keys %$hash) {
                 next unless ref($hash->{$k}) eq 'HASH' 
                          && exists $hash->{$k}->{$CLASS_MARKER};
-                $hash->{$k} = $OBJECT_HANDLERS{expand}->($hash->{$k})
+                $hash->{$k} = $OBJECT_HANDLERS{expand}->($hash->{$k}, @args);
             }
             $hash;            
         }, 
         collapse => sub {
-            my $hash = shift;   
+            my ( $hash, @args ) = @_;
             # NOTE:         
             # we need to make a copy cause
             # otherwise it will affect the 
             # other real version.
             +{ map {
                 blessed($hash->{$_})
-                    ? ($_ => $OBJECT_HANDLERS{collapse}->($hash->{$_}))
+                    ? ($_ => $OBJECT_HANDLERS{collapse}->($hash->{$_}), @args)
                     : ($_ => $hash->{$_})
             } keys %$hash }            
         } 

diff --git a/lib/MooseX/Storage/Format/JSON.pm b/lib/MooseX/Storage/Format/JSON.pm
index 7377c0e..9682d6c 100644 (file)
--- a/lib/MooseX/Storage/Format/JSON.pm
+++ b/lib/MooseX/Storage/Format/JSON.pm
@@ -2,6 +2,8 @@
 package MooseX::Storage::Format::JSON;
 use Moose::Role;
 
+no warnings 'once';
+
 use JSON::Any;
 
 our $VERSION = '0.02';
@@ -11,11 +13,13 @@ requires 'unpack';
 
 sub thaw {
     my ( $class, $json, @args ) = @_;
+    local $JSON::UnMapping = 1;
     $class->unpack( JSON::Any->jsonToObj($json), @args );
 }
 
 sub freeze {
     my ( $self, @args ) = @_;
+    local $JSON::UnMapping = 1;
     JSON::Any->objToJson( $self->pack(@args) );
 }
 

diff --git a/t/030_with_checksum.t b/t/030_with_checksum.t
index 5d51650..c144ec2 100644 (file)
--- a/t/030_with_checksum.t
+++ b/t/030_with_checksum.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 25;
+use Test::More tests => 26;
 use Test::Exception;
 use Test::Deep;
 
@@ -114,6 +114,8 @@ SKIP: {
     eval { require Digest::HMAC_SHA1 };
     skip join( " ", "no Digest::HMAC", ( $@ =~ /\@INC/ ? () : do { chomp(my $e = $@); "($e)" } ) ), 14 if $@;
 
+    local $::DEBUG = 1;
+
     my $foo = Foo->new(
         number => 10,
         string => 'foo',
@@ -127,6 +129,8 @@ SKIP: {
     my $frozen1 = $foo->freeze( digest => [ "HMAC_SHA1", "secret" ] );
     ok( length($frozen1), "got frozen data" );
 
+    $::DEBUG = 0;
+
     my $d2 = Digest::HMAC_SHA1->new("s3cr3t");
 
     my $frozen2 = $foo->freeze( digest => $d2 );
@@ -134,12 +138,16 @@ SKIP: {
 
     cmp_ok( $frozen1, "ne", $frozen2, "versions are different" );
 
+    is( $frozen1, $foo->freeze( digest => [ HMAC_SHA1 => "secret" ] ), "refreeze" );
+
+$::DEBUG = 1;
+
     my $foo1 = eval { Foo->thaw( $frozen1, digest => [ "HMAC_SHA1", "secret" ] ) };
     my $e = $@;
 
     ok( $foo1, "thawed" );
     ok( !$e, "no error" ) || diag $e;
-    
+
     my $foo2 = eval { Foo->thaw( $frozen2, digest => $d2 ) };
     $e = $@;