Commit | Line | Data |
c4a322ec |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
98ae09f0 |
6 | use Test::More tests => 25; |
c4a322ec |
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 | |
98ae09f0 |
20 | with Storage(base => 'WithChecksum', format => "JSON"); |
c4a322ec |
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', |
98ae09f0 |
47 | __DIGEST__ => re('[0-9a-f]+'), |
c4a322ec |
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', |
98ae09f0 |
55 | __DIGEST__ => re('[0-9a-f]+'), |
c4a322ec |
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', |
98ae09f0 |
72 | __DIGEST__ => re('[0-9a-f]+'), |
c4a322ec |
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', |
98ae09f0 |
80 | __DIGEST__ => re('[0-9a-f]+'), |
c4a322ec |
81 | number => 2 |
82 | }, |
83 | }, |
84 | '... got the right frozen class' |
85 | ); |
c4a322ec |
86 | } |
87 | |
98ae09f0 |
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 | } |