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