From: Stevan Little Date: Tue, 8 May 2007 17:40:52 +0000 (+0000) Subject: adding simple checksum role X-Git-Tag: 0_02~10 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMooseX-Storage.git;a=commitdiff_plain;h=c4a322ec86aff913da11191ac43d3edfbc403ab5 adding simple checksum role --- diff --git a/Build.PL b/Build.PL index 4468bfc..9c850ec 100644 --- a/Build.PL +++ b/Build.PL @@ -13,7 +13,10 @@ my $build = Module::Build->new( 'Best' => '0', # << this if for loading YAML # and the ability to save the # file to disk - 'IO::File' => '0', + 'IO::File' => '0', + # this if for the basic role with checksum + 'Digest::MD5' => '0', + 'Data::Dumper' => '0', }, optional => { 'IO::AtomicFile' => '0', diff --git a/Changes b/Changes index 421374d..b791ff2 100644 --- a/Changes +++ b/Changes @@ -1,6 +1,12 @@ Revision history for MooseX-Storage 0.02 + * MooseX::Storage::Base::WithChecksum + - added a simple base role which makes a checksum of + the data structure before packing, and checks the + checksum before unpacking. + - added tests for this + * MooseX::Storage::Engine - better error reporting when cycles are found - class names are now stored as the full identifier diff --git a/MANIFEST b/MANIFEST index a268d68..d8a7447 100644 --- a/MANIFEST +++ b/MANIFEST @@ -7,6 +7,7 @@ MANIFEST.SKIP README lib/MooseX/Storage.pm lib/MooseX/Storage/Basic.pm +lib/MooseX/Storage/Base/WithChecksum.pm lib/MooseX/Storage/Engine.pm lib/MooseX/Storage/Engine/IO/AtomicFile.pm lib/MooseX/Storage/Engine/IO/File.pm @@ -23,6 +24,7 @@ t/004_w_cycles.t t/005_w_versions_and_authority_check.t t/010_basic_json.t t/020_basic_yaml.t +t/030_with_checksum.t t/100_io.t t/101_io_atomic.t t/pod-coverage.t diff --git a/lib/MooseX/Storage.pm b/lib/MooseX/Storage.pm index 57a3347..c543fc8 100644 --- a/lib/MooseX/Storage.pm +++ b/lib/MooseX/Storage.pm @@ -17,7 +17,12 @@ sub import { $pkg->meta->alias_method('Storage' => sub { my %params = @_; - $params{'base'} ||= 'Basic'; + if (exists $params{'base'}) { + $params{'base'} = ('Base::' . $params{'base'}); + } + else { + $params{'base'} = 'Basic'; + } my @roles = ( ('MooseX::Storage::' . $params{'base'}), diff --git a/lib/MooseX/Storage/Base/WithChecksum.pm b/lib/MooseX/Storage/Base/WithChecksum.pm new file mode 100644 index 0000000..2f32787 --- /dev/null +++ b/lib/MooseX/Storage/Base/WithChecksum.pm @@ -0,0 +1,105 @@ + +package MooseX::Storage::Base::WithChecksum; +use Moose::Role; + +use Digest::MD5 ('md5_hex'); +use Data::Dumper (); +use MooseX::Storage::Engine; + +our $VERSION = '0.01'; + +sub pack { + my ($self, $salt) = @_; + my $e = MooseX::Storage::Engine->new( object => $self ); + my $collapsed = $e->collapse_object; + + # create checksum + + local $Data::Dumper::Sortkeys = 1; + my $dumped = Data::Dumper::Dumper($collapsed); + + #warn $dumped; + + $salt ||= $dumped; + + $collapsed->{checksum} = md5_hex($dumped, $salt); + + return $collapsed; +} + +sub unpack { + my ($class, $data, $salt) = @_; + + # check checksum on data + + my $old_checksum = $data->{checksum}; + delete $data->{checksum}; + + local $Data::Dumper::Sortkeys = 1; + my $dumped = Data::Dumper::Dumper($data); + + #warn $dumped; + + $salt ||= $dumped; + + my $checksum = md5_hex($dumped, $salt); + + ($checksum eq $old_checksum) + || confess "Bad Checksum got=($checksum) expected=($data->{checksum})"; + + my $e = MooseX::Storage::Engine->new(class => $class); + $class->new($e->expand_object($data)); +} + +1; + +__END__ + +=pod + +=head1 NAME + +MooseX::Storage::Base::WithChecksum + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head1 METHODS + +=over 4 + +=item B + +=item B + +=back + +=head2 Introspection + +=over 4 + +=item B + +=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 Estevan.little@iinteractive.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2007 by Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/lib/MooseX/Storage/Engine.pm b/lib/MooseX/Storage/Engine.pm index 9953dd9..430634a 100644 --- a/lib/MooseX/Storage/Engine.pm +++ b/lib/MooseX/Storage/Engine.pm @@ -189,8 +189,8 @@ my %OBJECT_HANDLERS = ( }, collapse => sub { my $obj = shift; - ($obj->can('does') && $obj->does('MooseX::Storage::Basic')) - || confess "Bad object ($obj) does not do MooseX::Storage::Basic role"; +# ($obj->can('does') && $obj->does('MooseX::Storage::Basic')) +# || confess "Bad object ($obj) does not do MooseX::Storage::Basic role"; $obj->pack(); }, ); diff --git a/t/030_with_checksum.t b/t/030_with_checksum.t new file mode 100644 index 0000000..1c72b95 --- /dev/null +++ b/t/030_with_checksum.t @@ -0,0 +1,88 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 6; +use Test::Exception; +use Test::Deep; + +BEGIN { + use_ok('MooseX::Storage'); +} + +{ + + package Foo; + use Moose; + use MooseX::Storage; + + with Storage(base => 'WithChecksum'); + + has 'number' => ( is => 'ro', isa => 'Int' ); + has 'string' => ( is => 'ro', isa => 'Str' ); + has 'float' => ( is => 'ro', isa => 'Num' ); + has 'array' => ( is => 'ro', isa => 'ArrayRef' ); + has 'hash' => ( is => 'ro', isa => 'HashRef' ); + has 'object' => ( is => 'ro', isa => 'Foo' ); +} + +{ + my $foo = Foo->new( + number => 10, + string => 'foo', + float => 10.5, + array => [ 1 .. 10 ], + hash => { map { $_ => undef } ( 1 .. 10 ) }, + object => Foo->new( number => 2 ), + ); + isa_ok( $foo, 'Foo' ); + + my $packed = $foo->pack; + + cmp_deeply( + $packed, + { + __CLASS__ => 'Foo', + checksum => re('[0-9a-f]+'), + number => 10, + string => 'foo', + float => 10.5, + array => [ 1 .. 10 ], + hash => { map { $_ => undef } ( 1 .. 10 ) }, + object => { + __CLASS__ => 'Foo', + checksum => re('[0-9a-f]+'), + number => 2 + }, + }, + '... got the right frozen class' + ); + + my $foo2; + lives_ok { + $foo2 = Foo->unpack($packed); + } '... unpacked okay'; + isa_ok($foo2, 'Foo'); + + cmp_deeply( + $foo2->pack, + { + __CLASS__ => 'Foo', + checksum => re('[0-9a-f]+'), + number => 10, + string => 'foo', + float => 10.5, + array => [ 1 .. 10 ], + hash => { map { $_ => undef } ( 1 .. 10 ) }, + object => { + __CLASS__ => 'Foo', + checksum => re('[0-9a-f]+'), + number => 2 + }, + }, + '... got the right frozen class' + ); + +} +