… | |
… | |
15 | |
15 | |
16 | =cut |
16 | =cut |
17 | |
17 | |
18 | package Types::Serialiser; |
18 | package Types::Serialiser; |
19 | |
19 | |
|
|
20 | use common::sense; # required to suppress annoying warnings |
|
|
21 | |
20 | our $VERSION = 0.01; |
22 | our $VERSION = 0.03; |
21 | |
23 | |
22 | =head1 SIMPLE SCALAR CONSTANTS |
24 | =head1 SIMPLE SCALAR CONSTANTS |
23 | |
25 | |
24 | 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 |
25 | 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 |
… | |
… | |
95 | |
97 | |
96 | =back |
98 | =back |
97 | |
99 | |
98 | =cut |
100 | =cut |
99 | |
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 | |
100 | our $true = do { bless \(my $dummy = 1), Types::Serialiser::Boolean:: }; |
124 | our $true = do { bless \(my $dummy = 1), Types::Serialiser::Boolean:: }; |
101 | our $false = do { bless \(my $dummy = 0), Types::Serialiser::Boolean:: }; |
125 | our $false = do { bless \(my $dummy = 0), Types::Serialiser::Boolean:: }; |
102 | our $error = do { bless \(my $dummy ), Types::Serialiser::Error:: }; |
126 | our $error = do { bless \(my $dummy ), Types::Serialiser::Error:: }; |
103 | |
127 | |
104 | sub true () { $true } |
128 | sub true () { $true } |
… | |
… | |
107 | |
131 | |
108 | sub is_bool ($) { UNIVERSAL::isa $_[0], Types::Serialiser::Boolean:: } |
132 | sub is_bool ($) { UNIVERSAL::isa $_[0], Types::Serialiser::Boolean:: } |
109 | sub is_true ($) { $_[0] && UNIVERSAL::isa $_[0], Types::Serialiser::Boolean:: } |
133 | sub is_true ($) { $_[0] && UNIVERSAL::isa $_[0], Types::Serialiser::Boolean:: } |
110 | sub is_false ($) { !$_[0] && UNIVERSAL::isa $_[0], Types::Serialiser::Boolean:: } |
134 | sub is_false ($) { !$_[0] && UNIVERSAL::isa $_[0], Types::Serialiser::Boolean:: } |
111 | sub is_error ($) { UNIVERSAL::isa $_[0], Types::Serialiser::Error:: } |
135 | sub is_error ($) { UNIVERSAL::isa $_[0], Types::Serialiser::Error:: } |
112 | |
|
|
113 | package Types::Serialiser::Boolean; |
|
|
114 | |
|
|
115 | use overload |
|
|
116 | "0+" => sub { ${$_[0]} }, |
|
|
117 | "++" => sub { $_[0] = ${$_[0]} + 1 }, |
|
|
118 | "--" => sub { $_[0] = ${$_[0]} - 1 }, |
|
|
119 | fallback => 1; |
|
|
120 | |
136 | |
121 | package Types::Serialiser::Error; |
137 | package Types::Serialiser::Error; |
122 | |
138 | |
123 | sub error { |
139 | sub error { |
124 | require Carp; |
140 | require Carp; |
… | |
… | |
139 | see if it's C<1> (true), C<0> (false) or C<undef> (error). |
155 | see if it's C<1> (true), C<0> (false) or C<undef> (error). |
140 | |
156 | |
141 | While it is possible to use an isa test, directly comparing stash pointers |
157 | While it is possible to use an isa test, directly comparing stash pointers |
142 | is faster and guaranteed to work. |
158 | is faster and guaranteed to work. |
143 | |
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 | |
144 | =head1 A GENERIC OBJECT SERIALIATION PROTOCOL |
166 | =head1 A GENERIC OBJECT SERIALIATION PROTOCOL |
145 | |
167 | |
146 | This section explains the object serialisation protocol used by |
168 | This section explains the object serialisation protocol used by |
147 | L<CBOR::XS>. It is meant to be generic enough to support any kind of |
169 | L<CBOR::XS>. It is meant to be generic enough to support any kind of |
148 | generic object serialiser. |
170 | generic object serialiser. |
… | |
… | |
155 | When the encoder encounters an object that it cannot otherwise encode (for |
177 | When the encoder encounters an object that it cannot otherwise encode (for |
156 | example, L<CBOR::XS> can encode a few special types itself, and will first |
178 | example, L<CBOR::XS> can encode a few special types itself, and will first |
157 | attempt to use the special C<TO_CBOR> serialisation protocol), it will |
179 | attempt to use the special C<TO_CBOR> serialisation protocol), it will |
158 | look up the C<FREEZE> method on the object. |
180 | look up the C<FREEZE> method on the object. |
159 | |
181 | |
160 | If it exists, it will call it with two arguments: the object to |
182 | If it exists, it will call it with two arguments: the object to serialise, |
161 | serialise, and a constant string that indicates the name of the |
183 | and a constant string that indicates the name of the data model or data |
162 | serialisationformat. For example L<CBOR::XS> uses C<CBOR>, and L<JSON> and |
184 | format. For example L<CBOR::XS> uses C<CBOR>, and L<JSON> and L<JSON::XS> |
163 | L<JSON::XS> (or any other JSON serialiser), would use C<JSON> as second |
185 | (or any other JSON serialiser), would use C<JSON> as second argument. |
164 | argument. |
|
|
165 | |
186 | |
166 | The C<FREEZE> method can then return zero or more values to identify the |
187 | The C<FREEZE> method can then return zero or more values to identify the |
167 | object instance. The serialiser is then supposed to encode the class name |
188 | object instance. The serialiser is then supposed to encode the class name |
168 | and all of these return values (which must be encodable in the format) |
189 | and all of these return values (which must be encodable in the format) |
169 | using the relevant form for perl objects. In CBOR for example, there is a |
190 | using the relevant form for perl objects. In CBOR for example, there is a |
170 | registered tag number for encoded perl objects. |
191 | registered tag number for encoded perl objects. |
171 | |
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 | |
172 | =head2 DECODING |
199 | =head2 DECODING |
173 | |
200 | |
174 | When the decoder then encounters such an encoded perl object, it should |
201 | When the decoder then encounters such an encoded perl object, it should |
175 | look up the C<THAW> method on the stored classname, and invoke it with the |
202 | look up the C<THAW> method on the stored classname, and invoke it with the |
176 | classname, the constant string to identify the format, and all the return |
203 | classname, the constant string to identify the data model/data format, and |
177 | values returned by C<FREEZE>. |
204 | all the return values returned by C<FREEZE>. |
178 | |
205 | |
179 | =head2 EXAMPLES |
206 | =head2 EXAMPLES |
180 | |
207 | |
181 | See the C<OBJECT SERIALISATION> section in the L<CBOR::XS> manpage for |
208 | See the C<OBJECT SERIALISATION> section in the L<CBOR::XS> manpage for |
182 | more details, an example implementation, and code examples. |
209 | more details, an example implementation, and code examples. |
183 | |
210 | |
184 | Here is an example C<FREEZE>/C<THAW> method pair: |
211 | Here is an example C<FREEZE>/C<THAW> method pair: |
185 | |
212 | |
186 | sub My::Object::FREEZE { |
213 | sub My::Object::FREEZE { |
187 | my ($self, $serialiser) = @_; |
214 | my ($self, $model) = @_; |
188 | |
215 | |
189 | ($self->{type}, $self->{id}, $self->{variant}) |
216 | ($self->{type}, $self->{id}, $self->{variant}) |
190 | } |
217 | } |
191 | |
218 | |
192 | sub My::Object::THAW { |
219 | sub My::Object::THAW { |
193 | my ($class, $serialiser, $type, $id, $variant) = @_; |
220 | my ($class, $model, $type, $id, $variant) = @_; |
194 | |
221 | |
195 | $class-<new (type => $type, id => $id, variant => $variant) |
222 | $class->new (type => $type, id => $id, variant => $variant) |
196 | } |
223 | } |
197 | |
224 | |
198 | =head1 BUGS |
225 | =head1 BUGS |
199 | |
226 | |
200 | 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 |