X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FStorage%2FBase%2FWithChecksum.pm;h=22c55931cfd3915413f97f1d9093bf18d6a23cfc;hb=004bf3ea04d7818116a94bb4b387d8ae1dd10f9a;hp=cf1ebdfc7ec4a0848cecf19afa35630524a86ce3;hpb=b7e2e91bccb1419a37f32f3cc99333750bb8d73e;p=gitmo%2FMooseX-Storage.git diff --git a/lib/MooseX/Storage/Base/WithChecksum.pm b/lib/MooseX/Storage/Base/WithChecksum.pm index cf1ebdf..22c5593 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.01'; +our $VERSION = '0.28'; 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 { @@ -53,7 +50,13 @@ sub _digest_packed { local $Data::Dumper::Useqq = 0; local $Data::Dumper::Deparse = 0; # FIXME? my $str = Data::Dumper::Dumper($collapsed); - $str =~ s/(?add( $str ); } @@ -63,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__ @@ -94,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 @@ -125,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. @@ -137,7 +142,7 @@ Yuval Kogman =head1 COPYRIGHT AND LICENSE -Copyright 2007 by Infinity Interactive, Inc. +Copyright 2007-2008 by Infinity Interactive, Inc. L