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