… | |
… | |
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 | withh 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. |
… | |
… | |
167 | object instance. The serialiser is then supposed to encode the class name |
189 | 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) |
190 | 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 |
191 | using the relevant form for perl objects. In CBOR for example, there is a |
170 | registered tag number for encoded perl objects. |
192 | registered tag number for encoded perl objects. |
171 | |
193 | |
|
|
194 | The values that C<FREEZE> returns must be serialisable with the serialiser |
|
|
195 | that calls it. Therefore, it is recommended to use simple types such as |
|
|
196 | strings and numbers, and maybe array references and hashes (basically, the |
|
|
197 | JSON data model). You can always use a more complex format for a specific |
|
|
198 | serialiser by checking the second argument. |
|
|
199 | |
172 | =head2 DECODING |
200 | =head2 DECODING |
173 | |
201 | |
174 | When the decoder then encounters such an encoded perl object, it should |
202 | 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 |
203 | 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 |
204 | classname, the constant string to identify the format, and all the return |
… | |
… | |
190 | } |
218 | } |
191 | |
219 | |
192 | sub My::Object::THAW { |
220 | sub My::Object::THAW { |
193 | my ($class, $serialiser, $type, $id, $variant) = @_; |
221 | my ($class, $serialiser, $type, $id, $variant) = @_; |
194 | |
222 | |
195 | $class-<new (type => $type, id => $id, variant => $variant) |
223 | $class->new (type => $type, id => $id, variant => $variant) |
196 | } |
224 | } |
197 | |
225 | |
198 | =head1 BUGS |
226 | =head1 BUGS |
199 | |
227 | |
200 | The use of L<overload> makes this module much heavier than it should be |
228 | The use of L<overload> makes this module much heavier than it should be |