X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FStorage%2FBase%2FWithChecksum.pm;h=73459c201f90c517466a150bbc7115d1f3c0bb05;hb=e44b5f5498b782752d2c91b6796698c86143a2f0;hp=5bb202646fc9f33ed1e5c853162c2c66273e5216;hpb=f4ffa4ef5e4cb4a1a43caf932db1b3478abe7b87;p=gitmo%2FMooseX-Storage.git diff --git a/lib/MooseX/Storage/Base/WithChecksum.pm b/lib/MooseX/Storage/Base/WithChecksum.pm index 5bb2026..73459c2 100644 --- a/lib/MooseX/Storage/Base/WithChecksum.pm +++ b/lib/MooseX/Storage/Base/WithChecksum.pm @@ -1,44 +1,41 @@ - package MooseX::Storage::Base::WithChecksum; use Moose::Role; +with 'MooseX::Storage::Basic'; + use Digest (); use Data::Dumper (); -use MooseX::Storage::Engine; - -our $VERSION = '0.17'; +our $VERSION = '0.32'; our $AUTHORITY = 'cpan:STEVAN'; our $DIGEST_MARKER = '__DIGEST__'; -sub pack { - my ($self, @args ) = @_; +around pack => sub { + my $orig = shift; + my $self = shift; + my @args = @_; - my $e = MooseX::Storage::Engine->new( object => $self ); + my $collapsed = $self->$orig( @args ); - my $collapsed = $e->collapse_object(@args); - $collapsed->{$DIGEST_MARKER} = $self->_digest_packed($collapsed, @args); - + return $collapsed; -} +}; -sub unpack { - my ($class, $data, @args) = @_; +around unpack => sub { + my ($orig, $class, $data, @args) = @_; # check checksum on data - my $old_checksum = delete $data->{$DIGEST_MARKER}; - + my $checksum = $class->_digest_packed($data, @args); ($checksum eq $old_checksum) - || confess "Bad Checksum got=($checksum) expected=($old_checksum)"; + || confess "Bad Checksum got=($checksum) expected=($old_checksum)"; - my $e = MooseX::Storage::Engine->new(class => $class); - $class->new($e->expand_object($data, @args)); -} + $class->$orig( $data, @args ); +}; sub _digest_packed { @@ -54,12 +51,12 @@ sub _digest_packed { local $Data::Dumper::Deparse = 0; # FIXME? my $str = Data::Dumper::Dumper($collapsed); # NOTE: - # Canonicalize numbers to strings even if it - # mangles numbers inside strings. It really + # Canonicalize numbers to strings even if it + # mangles numbers inside strings. It really # does not matter since its just the checksum # anyway. # - YK/SL - $str =~ s/(?add( $str ); } @@ -69,29 +66,31 @@ sub _digest_packed { sub _digest_object { my ( $self, %options ) = @_; my $digest_opts = $options{digest}; - - $digest_opts = [ $digest_opts ] + + $digest_opts = [ $digest_opts ] if !ref($digest_opts) or ref($digest_opts) ne 'ARRAY'; - + my ( $d, @args ) = @$digest_opts; if ( ref $d ) { if ( $d->can("clone") ) { return $d->clone; - } + } elsif ( $d->can("reset") ) { $d->reset; return $d; - } + } else { die "Can't clone or reset digest object: $d"; } - } + } else { - return Digest->new($d || "SHA1", @args); + return Digest->new($d || "SHA-1", @args); } } +no Moose::Role; + 1; __END__ @@ -104,11 +103,11 @@ MooseX::Storage::Base::WithChecksum - A more secure serialization role =head1 DESCRIPTION -This is an early implementation of a more secure Storage role, -which does integrity checks on the data. It is still being -developed so I recommend using it with caution. +This is an early implementation of a more secure Storage role, +which does integrity checks on the data. It is still being +developed so I recommend using it with caution. -Any thoughts, ideas or suggestions on improving our technique +Any thoughts, ideas or suggestions on improving our technique are very welcome. =head1 METHODS @@ -131,7 +130,7 @@ are very welcome. =head1 BUGS -All complex software has bugs lurking in it, and this module is no +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.