Commit | Line | Data |
1c6ac775 |
1 | use strict; |
2 | use warnings; |
3 | |
4 | use Test::More tests => 9; |
619ab942 |
5 | use Test::Deep; |
9d3c60f5 |
6 | use Test::Fatal; |
1c6ac775 |
7 | |
8 | BEGIN { |
9 | use_ok('MooseX::Storage'); |
c2dae5d8 |
10 | use_ok('MooseX::Storage::Engine'); |
1c6ac775 |
11 | } |
12 | |
13 | =pod |
14 | |
c2dae5d8 |
15 | This is just a simple example of defining |
1c6ac775 |
16 | a custom type handler to take care of custom |
c2dae5d8 |
17 | inflate and deflate needs. |
1c6ac775 |
18 | |
19 | =cut |
20 | |
21 | { |
22 | package Bar; |
23 | use Moose; |
c2dae5d8 |
24 | |
1c6ac775 |
25 | has 'baz' => (is => 'rw', isa => 'Str'); |
c2dae5d8 |
26 | has 'boo' => (is => 'rw', isa => 'Str'); |
27 | |
1c6ac775 |
28 | sub encode { |
29 | my $self = shift; |
30 | $self->baz . '|' . $self->boo; |
31 | } |
c2dae5d8 |
32 | |
1c6ac775 |
33 | sub decode { |
34 | my ($class, $packed) = @_; |
35 | my ($baz, $boo) = split /\|/ => $packed; |
36 | $class->new( |
37 | baz => $baz, |
38 | boo => $boo, |
39 | ); |
40 | } |
c2dae5d8 |
41 | |
1c6ac775 |
42 | MooseX::Storage::Engine->add_custom_type_handler( |
43 | 'Bar' => ( |
44 | expand => sub { Bar->decode(shift) }, |
45 | collapse => sub { (shift)->encode }, |
46 | ) |
47 | ); |
c2dae5d8 |
48 | |
1c6ac775 |
49 | package Foo; |
50 | use Moose; |
51 | use MooseX::Storage; |
c2dae5d8 |
52 | |
1c6ac775 |
53 | with Storage; |
c2dae5d8 |
54 | |
1c6ac775 |
55 | has 'bar' => ( |
56 | is => 'ro', |
57 | isa => 'Bar', |
58 | default => sub { |
59 | Bar->new(baz => 'BAZ', boo => 'BOO') |
60 | } |
61 | ); |
62 | } |
63 | |
64 | my $foo = Foo->new; |
65 | isa_ok($foo, 'Foo'); |
66 | |
67 | isa_ok($foo->bar, 'Bar'); |
68 | |
619ab942 |
69 | cmp_deeply( |
1c6ac775 |
70 | $foo->pack, |
71 | { |
72 | __CLASS__ => "Foo", |
73 | bar => "BAZ|BOO", |
74 | }, |
75 | '... got correct packed structure'); |
76 | |
77 | { |
78 | my $foo = Foo->unpack({ |
79 | __CLASS__ => "Foo", |
80 | bar => "BAZ|BOO", |
81 | }); |
82 | isa_ok($foo, 'Foo'); |
c2dae5d8 |
83 | |
84 | isa_ok($foo->bar, 'Bar'); |
85 | |
1c6ac775 |
86 | is($foo->bar->baz, 'BAZ', '... got the right stuff'); |
87 | is($foo->bar->boo, 'BOO', '... got the right stuff'); |
88 | } |
89 | |
90 | |
91 | |
92 | |
93 | |