Commit | Line | Data |
1f3074ea |
1 | package MooseX::Storage::Deferred; |
2 | use Moose::Role; |
3 | |
5ca52230 |
4 | our $VERSION = '0.18'; |
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 | |
65 | 1; |
66 | |
67 | __END__ |
68 | |
69 | =pod |
70 | |
71 | =head1 NAME |
72 | |
73 | MooseX::Storage::Deferred - A role for undecisive programmers |
74 | |
75 | =head1 SYNOPSIS |
76 | |
77 | package Point; |
78 | use Moose; |
79 | use MooseX::Storage; |
bf33d7c7 |
80 | |
1f3074ea |
81 | our $VERSION = '0.01'; |
bf33d7c7 |
82 | |
1f3074ea |
83 | with 'MooseX::Storage::Deferred'; |
bf33d7c7 |
84 | |
1f3074ea |
85 | has 'x' => (is => 'rw', isa => 'Int'); |
86 | has 'y' => (is => 'rw', isa => 'Int'); |
bf33d7c7 |
87 | |
1f3074ea |
88 | 1; |
bf33d7c7 |
89 | |
1f3074ea |
90 | my $p = Point->new(x => 10, y => 10); |
bf33d7c7 |
91 | |
92 | ## methods to freeze/thaw into |
1f3074ea |
93 | ## a specified serialization format |
94 | ## (in this case JSON) |
bf33d7c7 |
95 | |
1f3074ea |
96 | # pack the class into a JSON string |
97 | $p->freeze({ format => 'JSON' }); # { "__CLASS__" : "Point", "x" : 10, "y" : 10 } |
bf33d7c7 |
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 | |
120 | =item I<YAML> |
121 | |
122 | =item I<Storable> |
123 | |
124 | =back |
125 | |
126 | =head1 SUPPORTED I/O |
127 | |
128 | =over 4 |
129 | |
130 | =item I<File> |
131 | |
132 | =item I<AtomicFile> |
133 | |
134 | =back |
135 | |
136 | B<NOTE:> The B<StorableFile> I/O option is not supported, |
137 | this is because it does not mix well with options who also |
138 | have a C<thaw> and C<freeze> methods like this. It is possible |
139 | to probably work around this issue, but I don't currently |
140 | have the need for it. If you need this supported, talk to me |
141 | and I will see what I can do. |
142 | |
1f3074ea |
143 | =head1 METHODS |
144 | |
145 | =over 4 |
146 | |
147 | =item B<freeze ($type_desc)> |
148 | |
149 | =item B<thaw ($data, $type_desc)> |
150 | |
bf33d7c7 |
151 | =item B<load ($filename, $type_desc)> |
152 | |
153 | =item B<store ($filename, $type_desc)> |
154 | |
1f3074ea |
155 | =back |
156 | |
157 | =head2 Introspection |
158 | |
159 | =over 4 |
160 | |
161 | =item B<meta> |
162 | |
163 | =back |
164 | |
165 | =head1 BUGS |
166 | |
bf33d7c7 |
167 | All complex software has bugs lurking in it, and this module is no |
1f3074ea |
168 | exception. If you find a bug please either email me, or add the bug |
169 | to cpan-RT. |
170 | |
171 | =head1 AUTHOR |
172 | |
173 | Stevan Little E<lt>stevan.little@iinteractive.comE<gt> |
174 | |
175 | =head1 COPYRIGHT AND LICENSE |
176 | |
177 | Copyright 2007-2008 by Infinity Interactive, Inc. |
178 | |
179 | L<http://www.iinteractive.com> |
180 | |
181 | This library is free software; you can redistribute it and/or modify |
182 | it under the same terms as Perl itself. |
183 | |
184 | =cut |