t/030_with_checksum.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 25;
   7 use Test::Exception;
   8 use Test::Deep;
   9
  10 BEGIN {
  11     use_ok('MooseX::Storage');
  12 }
  13
  14 {
  15
  16     package Foo;
  17     use Moose;
  18     use MooseX::Storage;
  19
  20     with Storage(base => 'WithChecksum', format => "JSON");
  21
  22     has 'number' => ( is => 'ro', isa => 'Int' );
  23     has 'string' => ( is => 'ro', isa => 'Str' );
  24     has 'float'  => ( is => 'ro', isa => 'Num' );
  25     has 'array'  => ( is => 'ro', isa => 'ArrayRef' );
  26     has 'hash'   => ( is => 'ro', isa => 'HashRef' );
  27     has 'object' => ( is => 'ro', isa => 'Foo' );
  28 }
  29
  30 {
  31     my $foo = Foo->new(
  32         number => 10,
  33         string => 'foo',
  34         float  => 10.5,
  35         array  => [ 1 .. 10 ],
  36         hash   => { map { $_ => undef } ( 1 .. 10 ) },
  37         object => Foo->new( number => 2 ),
  38     );
  39     isa_ok( $foo, 'Foo' );
  40
  41     my $packed = $foo->pack;
  42
  43     cmp_deeply(
  44         $packed,
  45         {
  46             __CLASS__ => 'Foo',
  47             __DIGEST__  => re('[0-9a-f]+'),
  48             number    => 10,
  49             string    => 'foo',
  50             float     => 10.5,
  51             array     => [ 1 .. 10 ],
  52             hash      => { map { $_ => undef } ( 1 .. 10 ) },
  53             object    => {
  54                             __CLASS__ => 'Foo',
  55                             __DIGEST__  => re('[0-9a-f]+'),
  56                             number    => 2
  57                          },
  58         },
  59         '... got the right frozen class'
  60     );
  61
  62     my $foo2;
  63     lives_ok {
  64         $foo2 = Foo->unpack($packed);
  65     } '... unpacked okay';
  66     isa_ok($foo2, 'Foo');
  67
  68     cmp_deeply(
  69         $foo2->pack,
  70         {
  71             __CLASS__ => 'Foo',
  72             __DIGEST__  => re('[0-9a-f]+'),
  73             number    => 10,
  74             string    => 'foo',
  75             float     => 10.5,
  76             array     => [ 1 .. 10 ],
  77             hash      => { map { $_ => undef } ( 1 .. 10 ) },
  78             object    => {
  79                             __CLASS__ => 'Foo',
  80                             __DIGEST__  => re('[0-9a-f]+'),
  81                             number    => 2
  82                          },
  83         },
  84         '... got the right frozen class'
  85     );
  86 }
  87
  88 {
  89     my $foo = Foo->new(
  90         number => 10,
  91         string => 'foo',
  92         float  => 10.5,
  93         array  => [ 1 .. 10 ],
  94         hash   => { map { $_ => undef } ( 1 .. 10 ) },
  95         object => Foo->new( number => 2 ),
  96     );
  97     isa_ok( $foo, 'Foo' );
  98
  99     my $frozen = $foo->freeze;
 100
 101     ok( length($frozen), "got frozen data" );
 102
 103     $frozen =~ s/foo/bar/;
 104
 105     my $foo2 = eval { Foo->thaw( $frozen ) };
 106     my $e = $@;
 107
 108     ok( !$foo2, "not thawed" );
 109     ok( $e, "has error" );
 110     like( $e, qr/bad checksum/i, "bad checksum error" );
 111 }
 112
 113 SKIP: {
 114     eval { require Digest::HMAC_SHA1 };
 115     skip join( " ", "no Digest::HMAC", ( $@ =~ /\@INC/ ? () : do { chomp(my $e = $@); "($e)" } ) ), 14 if $@;
 116
 117     my $foo = Foo->new(
 118         number => 10,
 119         string => 'foo',
 120         float  => 10.5,
 121         array  => [ 1 .. 10 ],
 122         hash   => { map { $_ => undef } ( 1 .. 10 ) },
 123         object => Foo->new( number => 2 ),
 124     );
 125     isa_ok( $foo, 'Foo' );
 126
 127     my $frozen1 = $foo->freeze( "HMAC_SHA1", "secret" );
 128     ok( length($frozen1), "got frozen data" );
 129
 130     my $d2 = Digest::HMAC_SHA1->new("s3cr3t");
 131
 132     my $frozen2 = $foo->freeze( $d2 );
 133     ok( length($frozen2), "got frozen data" );
 134
 135     cmp_ok( $frozen1, "ne", $frozen2, "versions are different" );
 136
 137     my $foo1 = eval { Foo->thaw( $frozen1, "HMAC_SHA1", "secret" ) };
 138     my $e = $@;
 139
 140     ok( $foo1, "thawed" );
 141     ok( !$e, "no error" ) || diag $e;
 142
 143     my $foo2 = eval { Foo->thaw( $frozen2, $d2 ) };
 144     $e = $@;
 145
 146     ok( $foo2, "thawed" );
 147     ok( !$e, "no error" ) || diag $e;
 148
 149     $foo1 = eval { Foo->thaw( $frozen1, $d2 ) };
 150     $e = $@;
 151
 152     ok( !$foo1, "not thawed" );
 153     ok( $e, "has error" );
 154     like( $e, qr/bad checksum/i, "bad checksum error" );
 155
 156     $frozen1 =~ s/foo/bar/;
 157
 158     $foo1 = eval { Foo->thaw( $frozen1, "HMAC_SHA1", "secret" ) };
 159     $e = $@;
 160
 161     ok( !$foo1, "not thawed" );
 162     ok( $e, "has error" );
 163     like( $e, qr/bad checksum/i, "bad checksum error" );
 164 }