X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FStorage%2FBase%2FWithChecksum.pm;h=62564593c8f5021f97131b82181ba33c9e30d085;hb=a99b06bc698f521b77656a1015fb4c572e39dfeb;hp=207f388c56078beb1fff9171066dc0b715d8c989;hpb=1f3074ea2b80c4c8dfc081414f87285bc7892c82;p=gitmo%2FMooseX-Storage.git diff --git a/lib/MooseX/Storage/Base/WithChecksum.pm b/lib/MooseX/Storage/Base/WithChecksum.pm index 207f388..6256459 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.02'; +our $VERSION = '0.27'; 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); } } +no Moose::Role; + 1; __END__ @@ -100,15 +99,15 @@ __END__ =head1 NAME -MooseX::Storage::Base::WithChecksum +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.