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