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