… | |
… | |
15 | |
15 | |
16 | =cut |
16 | =cut |
17 | |
17 | |
18 | package Types::Serialiser; |
18 | package Types::Serialiser; |
19 | |
19 | |
20 | use common::sense; |
20 | use common::sense; # required to suppress annoying warnings |
21 | |
21 | |
22 | our $VERSION = 0.01; |
22 | our $VERSION = 0.03; |
23 | |
23 | |
24 | =head1 SIMPLE SCALAR CONSTANTS |
24 | =head1 SIMPLE SCALAR CONSTANTS |
25 | |
25 | |
26 | Simple scalar constants are values that are overloaded to act like simple |
26 | Simple scalar constants are values that are overloaded to act like simple |
27 | Perl values, but have (class) type to differentiate them from normal Perl |
27 | Perl values, but have (class) type to differentiate them from normal Perl |
… | |
… | |
97 | |
97 | |
98 | =back |
98 | =back |
99 | |
99 | |
100 | =cut |
100 | =cut |
101 | |
101 | |
|
|
102 | BEGIN { |
|
|
103 | # for historical reasons, and to avoid extra dependencies in JSON::PP, |
|
|
104 | # we alias *Types::Serialiser::Boolean with JSON::PP::Boolean. |
|
|
105 | package JSON::PP::Boolean; |
|
|
106 | |
|
|
107 | *Types::Serialiser::Boolean:: = *JSON::PP::Boolean::; |
|
|
108 | } |
|
|
109 | |
|
|
110 | { |
|
|
111 | # this must done before blessing to work around bugs |
|
|
112 | # in perl < 5.18 (it seems to be fixed in 5.18). |
|
|
113 | package Types::Serialiser::BooleanBase; |
|
|
114 | |
|
|
115 | use overload |
|
|
116 | "0+" => sub { ${$_[0]} }, |
|
|
117 | "++" => sub { $_[0] = ${$_[0]} + 1 }, |
|
|
118 | "--" => sub { $_[0] = ${$_[0]} - 1 }, |
|
|
119 | fallback => 1; |
|
|
120 | |
|
|
121 | @Types::Serialiser::Boolean::ISA = Types::Serialiser::BooleanBase::; |
|
|
122 | } |
|
|
123 | |
102 | our $true = do { bless \(my $dummy = 1), Types::Serialiser::Boolean:: }; |
124 | our $true = do { bless \(my $dummy = 1), Types::Serialiser::Boolean:: }; |
103 | our $false = do { bless \(my $dummy = 0), Types::Serialiser::Boolean:: }; |
125 | our $false = do { bless \(my $dummy = 0), Types::Serialiser::Boolean:: }; |
104 | our $error = do { bless \(my $dummy ), Types::Serialiser::Error:: }; |
126 | our $error = do { bless \(my $dummy ), Types::Serialiser::Error:: }; |
105 | |
127 | |
106 | sub true () { $true } |
128 | sub true () { $true } |
… | |
… | |
110 | sub is_bool ($) { UNIVERSAL::isa $_[0], Types::Serialiser::Boolean:: } |
132 | sub is_bool ($) { UNIVERSAL::isa $_[0], Types::Serialiser::Boolean:: } |
111 | sub is_true ($) { $_[0] && UNIVERSAL::isa $_[0], Types::Serialiser::Boolean:: } |
133 | sub is_true ($) { $_[0] && UNIVERSAL::isa $_[0], Types::Serialiser::Boolean:: } |
112 | sub is_false ($) { !$_[0] && UNIVERSAL::isa $_[0], Types::Serialiser::Boolean:: } |
134 | sub is_false ($) { !$_[0] && UNIVERSAL::isa $_[0], Types::Serialiser::Boolean:: } |
113 | sub is_error ($) { UNIVERSAL::isa $_[0], Types::Serialiser::Error:: } |
135 | sub is_error ($) { UNIVERSAL::isa $_[0], Types::Serialiser::Error:: } |
114 | |
136 | |
115 | package Types::Serialiser::Boolean; |
|
|
116 | |
|
|
117 | use overload |
|
|
118 | "0+" => sub { ${$_[0]} }, |
|
|
119 | "++" => sub { $_[0] = ${$_[0]} + 1 }, |
|
|
120 | "--" => sub { $_[0] = ${$_[0]} - 1 }, |
|
|
121 | fallback => 1; |
|
|
122 | |
|
|
123 | package Types::Serialiser::Error; |
137 | package Types::Serialiser::Error; |
124 | |
138 | |
125 | sub error { |
139 | sub error { |
126 | require Carp; |
140 | require Carp; |
127 | Carp::croak ("caught attempt to use Types::Serialiser::error value"); |
141 | Carp::croak ("caught attempt to use the Types::Serialiser::error value"); |
128 | }; |
142 | }; |
129 | |
143 | |
130 | use overload |
144 | use overload |
131 | "0+" => \&error, |
145 | "0+" => \&error, |
132 | "++" => \&error, |
146 | "++" => \&error, |
133 | "--" => \&error, |
147 | "--" => \&error, |
134 | fallback => 1; |
148 | fallback => 1; |
135 | |
149 | |
|
|
150 | =head1 NOTES FOR XS USERS |
|
|
151 | |
|
|
152 | The recommended way to detect whether a scalar is one of these objects |
|
|
153 | is to check whether the stash is the C<Types::Serialiser::Boolean> or |
|
|
154 | C<Types::Serialiser::Error> stash, and then follow the scalar reference to |
|
|
155 | see if it's C<1> (true), C<0> (false) or C<undef> (error). |
|
|
156 | |
|
|
157 | While it is possible to use an isa test, directly comparing stash pointers |
|
|
158 | is faster and guaranteed to work. |
|
|
159 | |
|
|
160 | For historical reasons, the C<Types::Serialiser::Boolean> stash is |
|
|
161 | just an alias for C<JSON::PP::Boolean>. When printed, the classname |
|
|
162 | with usually be C<JSON::PP::Boolean>, but isa tests and stash pointer |
|
|
163 | comparison will normally work correctly (i.e. Types::Serialiser::true ISA |
|
|
164 | JSON::PP::Boolean, but also ISA Types::Serialiser::Boolean). |
|
|
165 | |
|
|
166 | =head1 A GENERIC OBJECT SERIALIATION PROTOCOL |
|
|
167 | |
|
|
168 | This section explains the object serialisation protocol used by |
|
|
169 | L<CBOR::XS>. It is meant to be generic enough to support any kind of |
|
|
170 | generic object serialiser. |
|
|
171 | |
|
|
172 | This protocol is called "the Types::Serialiser object serialisation |
|
|
173 | protocol". |
|
|
174 | |
|
|
175 | =head2 ENCODING |
|
|
176 | |
|
|
177 | When the encoder encounters an object that it cannot otherwise encode (for |
|
|
178 | example, L<CBOR::XS> can encode a few special types itself, and will first |
|
|
179 | attempt to use the special C<TO_CBOR> serialisation protocol), it will |
|
|
180 | look up the C<FREEZE> method on the object. |
|
|
181 | |
|
|
182 | If it exists, it will call it with two arguments: the object to serialise, |
|
|
183 | and a constant string that indicates the name of the data model or data |
|
|
184 | format. For example L<CBOR::XS> uses C<CBOR>, and L<JSON> and L<JSON::XS> |
|
|
185 | (or any other JSON serialiser), would use C<JSON> as second argument. |
|
|
186 | |
|
|
187 | The C<FREEZE> method can then return zero or more values to identify the |
|
|
188 | object instance. The serialiser is then supposed to encode the class name |
|
|
189 | and all of these return values (which must be encodable in the format) |
|
|
190 | using the relevant form for perl objects. In CBOR for example, there is a |
|
|
191 | registered tag number for encoded perl objects. |
|
|
192 | |
|
|
193 | The values that C<FREEZE> returns must be serialisable with the serialiser |
|
|
194 | that calls it. Therefore, it is recommended to use simple types such as |
|
|
195 | strings and numbers, and maybe array references and hashes (basically, the |
|
|
196 | JSON data model). You can always use a more complex format for a specific |
|
|
197 | data model by checking the second argument. |
|
|
198 | |
|
|
199 | =head2 DECODING |
|
|
200 | |
|
|
201 | When the decoder then encounters such an encoded perl object, it should |
|
|
202 | look up the C<THAW> method on the stored classname, and invoke it with the |
|
|
203 | classname, the constant string to identify the data model/data format, and |
|
|
204 | all the return values returned by C<FREEZE>. |
|
|
205 | |
|
|
206 | =head2 EXAMPLES |
|
|
207 | |
|
|
208 | See the C<OBJECT SERIALISATION> section in the L<CBOR::XS> manpage for |
|
|
209 | more details, an example implementation, and code examples. |
|
|
210 | |
|
|
211 | Here is an example C<FREEZE>/C<THAW> method pair: |
|
|
212 | |
|
|
213 | sub My::Object::FREEZE { |
|
|
214 | my ($self, $model) = @_; |
|
|
215 | |
|
|
216 | ($self->{type}, $self->{id}, $self->{variant}) |
|
|
217 | } |
|
|
218 | |
|
|
219 | sub My::Object::THAW { |
|
|
220 | my ($class, $model, $type, $id, $variant) = @_; |
|
|
221 | |
|
|
222 | $class->new (type => $type, id => $id, variant => $variant) |
|
|
223 | } |
|
|
224 | |
136 | =head1 BUGS |
225 | =head1 BUGS |
137 | |
226 | |
138 | The use of L<overload> makes this module much heavier than it should be |
227 | The use of L<overload> makes this module much heavier than it should be |
139 | (on my system, this module: 4kB RSS, overload: 260kB RSS). |
228 | (on my system, this module: 4kB RSS, overload: 260kB RSS). |
140 | |
229 | |