ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Types-Serialiser/Serialiser.pm
(Generate patch)

Comparing Types-Serialiser/Serialiser.pm (file contents):
Revision 1.4 by root, Mon Oct 28 15:28:44 2013 UTC vs.
Revision 1.8 by root, Mon Nov 4 15:12:16 2013 UTC

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

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines