Commit | Line | Data |
1f3074ea |
1 | package MooseX::Storage::Deferred; |
2 | use Moose::Role; |
3 | |
8919e01e |
4 | our $VERSION = '0.26'; |
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 | |
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 | |
117 | =item I<YAML> |
118 | |
119 | =item I<Storable> |
120 | |
121 | =back |
122 | |
123 | =head1 SUPPORTED I/O |
124 | |
125 | =over 4 |
126 | |
127 | =item I<File> |
128 | |
129 | =item I<AtomicFile> |
130 | |
131 | =back |
132 | |
ec725183 |
133 | B<NOTE:> The B<StorableFile> I/O option is not supported, |
134 | this is because it does not mix well with options who also |
bf33d7c7 |
135 | have a C<thaw> and C<freeze> methods like this. It is possible |
ec725183 |
136 | to probably work around this issue, but I don't currently |
bf33d7c7 |
137 | have the need for it. If you need this supported, talk to me |
ec725183 |
138 | and I will see what I can do. |
bf33d7c7 |
139 | |
1f3074ea |
140 | =head1 METHODS |
141 | |
142 | =over 4 |
143 | |
144 | =item B<freeze ($type_desc)> |
145 | |
146 | =item B<thaw ($data, $type_desc)> |
147 | |
bf33d7c7 |
148 | =item B<load ($filename, $type_desc)> |
149 | |
150 | =item B<store ($filename, $type_desc)> |
151 | |
1f3074ea |
152 | =back |
153 | |
154 | =head2 Introspection |
155 | |
156 | =over 4 |
157 | |
158 | =item B<meta> |
159 | |
160 | =back |
161 | |
162 | =head1 BUGS |
163 | |
bf33d7c7 |
164 | All complex software has bugs lurking in it, and this module is no |
1f3074ea |
165 | exception. If you find a bug please either email me, or add the bug |
166 | to cpan-RT. |
167 | |
168 | =head1 AUTHOR |
169 | |
170 | Stevan Little E<lt>stevan.little@iinteractive.comE<gt> |
171 | |
172 | =head1 COPYRIGHT AND LICENSE |
173 | |
174 | Copyright 2007-2008 by Infinity Interactive, Inc. |
175 | |
176 | L<http://www.iinteractive.com> |
177 | |
178 | This library is free software; you can redistribute it and/or modify |
179 | it under the same terms as Perl itself. |
180 | |
181 | =cut |