From: Yuval Kogman Date: Wed, 6 Jun 2007 18:57:37 +0000 (+0000) Subject: swithc to Data::Dumper X-Git-Tag: 0_02~3 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=34dcaa5dd9078dbf394ffc0f326765244675faab;p=gitmo%2FMooseX-Storage.git swithc to Data::Dumper --- diff --git a/lib/MooseX/Storage/Base/WithChecksum.pm b/lib/MooseX/Storage/Base/WithChecksum.pm index 227c447..496ca72 100644 --- 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 --- 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 --- 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 --- 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 = $@;