Commit | Line | Data |
1f3074ea |
1 | package MooseX::Storage::Deferred; |
2 | use Moose::Role; |
3 | |
14e5132a |
4 | our $VERSION = '0.21'; |
1f3074ea |
5 | our $AUTHORITY = 'cpan:STEVAN'; |
6 | |
7 | with 'MooseX::Storage::Basic'; |
8 | |
9 | sub thaw { |
10 | my ( $class, $packed, $type, @args ) = @_; |
bf33d7c7 |
11 | |
12 | (exists $type->{format}) |
1f3074ea |
13 | || confess "You must specify a format type to thaw from"; |
14 | |
15 | my $class_to_load = 'MooseX::Storage::Format::' . $type->{format}; |
16 | Class::MOP::load_class($class_to_load); |
bf33d7c7 |
17 | |
1f3074ea |
18 | my $method_to_call = $class_to_load . '::thaw'; |
bf33d7c7 |
19 | |
1f3074ea |
20 | $class->$method_to_call($packed, @args); |
21 | } |
22 | |
23 | sub freeze { |
24 | my ( $self, $type, @args ) = @_; |
bf33d7c7 |
25 | |
26 | (exists $type->{format}) |
27 | || confess "You must specify a format type to freeze into"; |
28 | |
1f3074ea |
29 | my $class_to_load = 'MooseX::Storage::Format::' . $type->{format}; |
30 | Class::MOP::load_class($class_to_load); |
31 | |
32 | my $method_to_call = $class_to_load . '::freeze'; |
bf33d7c7 |
33 | |
34 | $self->$method_to_call(@args); |
35 | } |
36 | |
37 | sub load { |
38 | my ( $class, $filename, $type, @args ) = @_; |
39 | |
40 | (exists $type->{io}) |
41 | || confess "You must specify an I/O type to load with"; |
42 | |
43 | my $class_to_load = 'MooseX::Storage::IO::' . $type->{io}; |
44 | Class::MOP::load_class($class_to_load); |
45 | |
46 | my $method_to_call = $class_to_load . '::load'; |
47 | |
48 | $class->$method_to_call($filename, $type, @args); |
49 | } |
50 | |
51 | sub store { |
52 | my ( $self, $filename, $type, @args ) = @_; |
53 | |
54 | (exists $type->{io}) |
55 | || confess "You must specify an I/O type to store with"; |
56 | |
57 | my $class_to_load = 'MooseX::Storage::IO::' . $type->{io}; |
58 | Class::MOP::load_class($class_to_load); |
59 | |
60 | my $method_to_call = $class_to_load . '::store'; |
61 | |
62 | $self->$method_to_call($filename, $type, @args); |
1f3074ea |
63 | } |
64 | |
f82612bc |
65 | no Moose::Role; |
66 | |
1f3074ea |
67 | 1; |
68 | |
69 | __END__ |
70 | |
71 | =pod |
72 | |
73 | =head1 NAME |
74 | |
75 | MooseX::Storage::Deferred - A role for undecisive programmers |
76 | |
77 | =head1 SYNOPSIS |
78 | |
79 | package Point; |
80 | use Moose; |
81 | use MooseX::Storage; |
bf33d7c7 |
82 | |
1f3074ea |
83 | our $VERSION = '0.01'; |
bf33d7c7 |
84 | |
1f3074ea |
85 | with 'MooseX::Storage::Deferred'; |
bf33d7c7 |
86 | |
1f3074ea |
87 | has 'x' => (is => 'rw', isa => 'Int'); |
88 | has 'y' => (is => 'rw', isa => 'Int'); |
bf33d7c7 |
89 | |
1f3074ea |
90 | 1; |
bf33d7c7 |
91 | |
1f3074ea |
92 | my $p = Point->new(x => 10, y => 10); |
bf33d7c7 |
93 | |
94 | ## methods to freeze/thaw into |
1f3074ea |
95 | ## a specified serialization format |
96 | ## (in this case JSON) |
bf33d7c7 |
97 | |
1f3074ea |
98 | # pack the class into a JSON string |
99 | $p->freeze({ format => 'JSON' }); # { "__CLASS__" : "Point", "x" : 10, "y" : 10 } |
bf33d7c7 |
100 | |
1f3074ea |
101 | # unpack the JSON string into a class |
102 | my $p2 = Point->thaw( |
103 | '{ "__CLASS__" : "Point", "x" : 10, "y" : 10 }', |
104 | { format => 'JSON' } |
bf33d7c7 |
105 | ); |
1f3074ea |
106 | |
107 | =head1 DESCRIPTION |
108 | |
bf33d7c7 |
109 | This role is designed for those times when you need to |
110 | serialize into many different formats or I/O options. |
111 | |
112 | It basically allows you to choose the format and IO |
113 | options only when you actually use them (see the |
1f3074ea |
114 | SYNOPSIS for more info) |
115 | |
bf33d7c7 |
116 | =head1 SUPPORTED FORMATS |
117 | |
118 | =over 4 |
119 | |
120 | =item I<JSON> |
121 | |
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 |