Commit | Line | Data |
1f3074ea |
1 | package MooseX::Storage::Deferred; |
2 | use Moose::Role; |
3 | |
efd4f7a5 |
4 | our $VERSION = '0.35'; |
1f3074ea |
5 | our $AUTHORITY = 'cpan:STEVAN'; |
6 | |
7 | with 'MooseX::Storage::Basic'; |
8 | |
61fb1aaa |
9 | sub __get_method { |
10 | my ( $self, $basename, $value, $method_name ) = @_; |
11 | |
12 | my $role = MooseX::Storage->_expand_role($basename => $value)->meta; |
13 | my $method = $role->get_method($method_name)->body; |
14 | } |
15 | |
1f3074ea |
16 | sub thaw { |
17 | my ( $class, $packed, $type, @args ) = @_; |
bf33d7c7 |
18 | |
19 | (exists $type->{format}) |
1f3074ea |
20 | || confess "You must specify a format type to thaw from"; |
21 | |
61fb1aaa |
22 | my $code = $class->__get_method(Format => $type->{format} => 'thaw'); |
bf33d7c7 |
23 | |
61fb1aaa |
24 | $class->$code($packed, @args); |
1f3074ea |
25 | } |
26 | |
27 | sub freeze { |
28 | my ( $self, $type, @args ) = @_; |
bf33d7c7 |
29 | |
30 | (exists $type->{format}) |
31 | || confess "You must specify a format type to freeze into"; |
32 | |
61fb1aaa |
33 | my $code = $self->__get_method(Format => $type->{format} => 'freeze'); |
1f3074ea |
34 | |
61fb1aaa |
35 | $self->$code(@args); |
bf33d7c7 |
36 | } |
37 | |
38 | sub load { |
39 | my ( $class, $filename, $type, @args ) = @_; |
40 | |
41 | (exists $type->{io}) |
42 | || confess "You must specify an I/O type to load with"; |
43 | |
61fb1aaa |
44 | my $code = $class->__get_method(IO => $type->{io} => 'load'); |
bf33d7c7 |
45 | |
61fb1aaa |
46 | $class->$code($filename, $type, @args); |
bf33d7c7 |
47 | } |
48 | |
49 | sub store { |
50 | my ( $self, $filename, $type, @args ) = @_; |
51 | |
52 | (exists $type->{io}) |
53 | || confess "You must specify an I/O type to store with"; |
54 | |
61fb1aaa |
55 | my $code = $self->__get_method(IO => $type->{io} => 'store'); |
bf33d7c7 |
56 | |
61fb1aaa |
57 | $self->$code($filename, $type, @args); |
1f3074ea |
58 | } |
59 | |
f82612bc |
60 | no Moose::Role; |
61 | |
1f3074ea |
62 | 1; |
63 | |
64 | __END__ |
65 | |
66 | =pod |
67 | |
68 | =head1 NAME |
69 | |
70 | MooseX::Storage::Deferred - A role for undecisive programmers |
71 | |
72 | =head1 SYNOPSIS |
73 | |
74 | package Point; |
75 | use Moose; |
76 | use MooseX::Storage; |
bf33d7c7 |
77 | |
1f3074ea |
78 | our $VERSION = '0.01'; |
bf33d7c7 |
79 | |
1f3074ea |
80 | with 'MooseX::Storage::Deferred'; |
bf33d7c7 |
81 | |
1f3074ea |
82 | has 'x' => (is => 'rw', isa => 'Int'); |
83 | has 'y' => (is => 'rw', isa => 'Int'); |
bf33d7c7 |
84 | |
1f3074ea |
85 | 1; |
bf33d7c7 |
86 | |
1f3074ea |
87 | my $p = Point->new(x => 10, y => 10); |
bf33d7c7 |
88 | |
89 | ## methods to freeze/thaw into |
1f3074ea |
90 | ## a specified serialization format |
91 | ## (in this case JSON) |
bf33d7c7 |
92 | |
1f3074ea |
93 | # pack the class into a JSON string |
94 | $p->freeze({ format => 'JSON' }); # { "__CLASS__" : "Point", "x" : 10, "y" : 10 } |
bf33d7c7 |
95 | |
39535ada |
96 | # pack the class into a JSON string using parameterized JSONpm role |
97 | $p->freeze({ format => [ JSONpm => { json_opts => { pretty => 1 } } ] }); |
98 | |
1f3074ea |
99 | # unpack the JSON string into a class |
100 | my $p2 = Point->thaw( |
101 | '{ "__CLASS__" : "Point", "x" : 10, "y" : 10 }', |
102 | { format => 'JSON' } |
bf33d7c7 |
103 | ); |
1f3074ea |
104 | |
105 | =head1 DESCRIPTION |
106 | |
bf33d7c7 |
107 | This role is designed for those times when you need to |
108 | serialize into many different formats or I/O options. |
109 | |
110 | It basically allows you to choose the format and IO |
111 | options only when you actually use them (see the |
1f3074ea |
112 | SYNOPSIS for more info) |
113 | |
bf33d7c7 |
114 | =head1 SUPPORTED FORMATS |
115 | |
116 | =over 4 |
117 | |
118 | =item I<JSON> |
119 | |
39535ada |
120 | =item I<JSONpm> |
121 | |
bf33d7c7 |
122 | =item I<YAML> |
123 | |
124 | =item I<Storable> |
125 | |
126 | =back |
127 | |
128 | =head1 SUPPORTED I/O |
129 | |
130 | =over 4 |
131 | |
132 | =item I<File> |
133 | |
134 | =item I<AtomicFile> |
135 | |
136 | =back |
137 | |
ec725183 |
138 | B<NOTE:> The B<StorableFile> I/O option is not supported, |
139 | this is because it does not mix well with options who also |
bf33d7c7 |
140 | have a C<thaw> and C<freeze> methods like this. It is possible |
ec725183 |
141 | to probably work around this issue, but I don't currently |
bf33d7c7 |
142 | have the need for it. If you need this supported, talk to me |
ec725183 |
143 | and I will see what I can do. |
bf33d7c7 |
144 | |
1f3074ea |
145 | =head1 METHODS |
146 | |
147 | =over 4 |
148 | |
149 | =item B<freeze ($type_desc)> |
150 | |
151 | =item B<thaw ($data, $type_desc)> |
152 | |
bf33d7c7 |
153 | =item B<load ($filename, $type_desc)> |
154 | |
155 | =item B<store ($filename, $type_desc)> |
156 | |
1f3074ea |
157 | =back |
158 | |
159 | =head2 Introspection |
160 | |
161 | =over 4 |
162 | |
163 | =item B<meta> |
164 | |
165 | =back |
166 | |
167 | =head1 BUGS |
168 | |
bf33d7c7 |
169 | All complex software has bugs lurking in it, and this module is no |
1f3074ea |
170 | exception. If you find a bug please either email me, or add the bug |
171 | to cpan-RT. |
172 | |
173 | =head1 AUTHOR |
174 | |
175 | Stevan Little E<lt>stevan.little@iinteractive.comE<gt> |
176 | |
177 | =head1 COPYRIGHT AND LICENSE |
178 | |
179 | Copyright 2007-2008 by Infinity Interactive, Inc. |
180 | |
181 | L<http://www.iinteractive.com> |
182 | |
183 | This library is free software; you can redistribute it and/or modify |
184 | it under the same terms as Perl itself. |
185 | |
186 | =cut |