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

Comparing CBOR-XS/XS.pm (file contents):
Revision 1.4 by root, Sat Oct 26 22:25:47 2013 UTC vs.
Revision 1.23 by root, Fri Nov 22 16:00:30 2013 UTC

12 $perl_value = decode_cbor $binary_cbor_data; 12 $perl_value = decode_cbor $binary_cbor_data;
13 13
14 # OO-interface 14 # OO-interface
15 15
16 $coder = CBOR::XS->new; 16 $coder = CBOR::XS->new;
17 #TODO 17 $binary_cbor_data = $coder->encode ($perl_value);
18 $perl_value = $coder->decode ($binary_cbor_data);
19
20 # prefix decoding
21
22 my $many_cbor_strings = ...;
23 while (length $many_cbor_strings) {
24 my ($data, $length) = $cbor->decode_prefix ($many_cbor_strings);
25 # data was decoded
26 substr $many_cbor_strings, 0, $length, ""; # remove decoded cbor string
27 }
18 28
19=head1 DESCRIPTION 29=head1 DESCRIPTION
20 30
21WARNING! THIS IS A PRE-ALPHA RELEASE! IT WILL CRASH, CORRUPT YOUR DATA AND 31WARNING! This module is very new, and not very well tested (that's up
22EAT YOUR CHILDREN! 32to you to do). Furthermore, details of the implementation might change
33freely before version 1.0. And lastly, most extensions depend on an IANA
34assignment, and until that assignment is official, this implementation is
35not interoperable with other implementations (even future versions of this
36module) until the assignment is done.
23 37
24This module converts Perl data structures to CBOR and vice versa. Its 38You are still invited to try out CBOR, and this module.
39
40This module converts Perl data structures to the Concise Binary Object
41Representation (CBOR) and vice versa. CBOR is a fast binary serialisation
42format that aims to use a superset of the JSON data model, i.e. when you
43can represent something in JSON, you should be able to represent it in
44CBOR.
45
46In short, CBOR is a faster and very compact binary alternative to JSON,
47with the added ability of supporting serialisation of Perl objects. (JSON
48often compresses better than CBOR though, so if you plan to compress the
49data later you might want to compare both formats first).
50
51To give you a general idea about speed, with texts in the megabyte range,
52C<CBOR::XS> usually encodes roughly twice as fast as L<Storable> or
53L<JSON::XS> and decodes about 15%-30% faster than those. The shorter the
54data, the worse L<Storable> performs in comparison.
55
56As for compactness, C<CBOR::XS> encoded data structures are usually about
5720% smaller than the same data encoded as (compact) JSON or L<Storable>.
58
59In addition to the core CBOR data format, this module implements a number
60of extensions, to support cyclic and self-referencing data structures
61(see C<allow_sharing>), string deduplication (see C<allow_stringref>) and
62scalar references (always enabled).
63
25primary goal is to be I<correct> and its secondary goal is to be 64The primary goal of this module is to be I<correct> and the secondary goal
26I<fast>. To reach the latter goal it was written in C. 65is to be I<fast>. To reach the latter goal it was written in C.
27 66
28See MAPPING, below, on how CBOR::XS maps perl values to CBOR values and 67See MAPPING, below, on how CBOR::XS maps perl values to CBOR values and
29vice versa. 68vice versa.
30 69
31=cut 70=cut
32 71
33package CBOR::XS; 72package CBOR::XS;
34 73
35use common::sense; 74use common::sense;
36 75
37our $VERSION = 0.02; 76our $VERSION = 0.08;
38our @ISA = qw(Exporter); 77our @ISA = qw(Exporter);
39 78
40our @EXPORT = qw(encode_cbor decode_cbor); 79our @EXPORT = qw(encode_cbor decode_cbor);
41 80
42use Exporter; 81use Exporter;
43use XSLoader; 82use XSLoader;
44 83
84use Types::Serialiser;
85
45our $MAGIC = "\xd9\xd9\xf7"; 86our $MAGIC = "\xd9\xd9\xf7";
46 87
47=head1 FUNCTIONAL INTERFACE 88=head1 FUNCTIONAL INTERFACE
48 89
49The following convenience methods are provided by this module. They are 90The following convenience methods are provided by this module. They are
77strings. All boolean flags described below are by default I<disabled>. 118strings. All boolean flags described below are by default I<disabled>.
78 119
79The mutators for flags all return the CBOR object again and thus calls can 120The mutators for flags all return the CBOR object again and thus calls can
80be chained: 121be chained:
81 122
82#TODO
83 my $cbor = CBOR::XS->new->encode ({a => [1,2]}); 123 my $cbor = CBOR::XS->new->encode ({a => [1,2]});
84 124
85=item $cbor = $cbor->max_depth ([$maximum_nesting_depth]) 125=item $cbor = $cbor->max_depth ([$maximum_nesting_depth])
86 126
87=item $max_depth = $cbor->get_max_depth 127=item $max_depth = $cbor->get_max_depth
121If no argument is given, the limit check will be deactivated (same as when 161If no argument is given, the limit check will be deactivated (same as when
122C<0> is specified). 162C<0> is specified).
123 163
124See SECURITY CONSIDERATIONS, below, for more info on why this is useful. 164See SECURITY CONSIDERATIONS, below, for more info on why this is useful.
125 165
166=item $cbor = $cbor->allow_unknown ([$enable])
167
168=item $enabled = $cbor->get_allow_unknown
169
170If C<$enable> is true (or missing), then C<encode> will I<not> throw an
171exception when it encounters values it cannot represent in CBOR (for
172example, filehandles) but instead will encode a CBOR C<error> value.
173
174If C<$enable> is false (the default), then C<encode> will throw an
175exception when it encounters anything it cannot encode as CBOR.
176
177This option does not affect C<decode> in any way, and it is recommended to
178leave it off unless you know your communications partner.
179
180=item $cbor = $cbor->allow_sharing ([$enable])
181
182=item $enabled = $cbor->get_allow_sharing
183
184If C<$enable> is true (or missing), then C<encode> will not double-encode
185values that have been referenced before (e.g. when the same object, such
186as an array, is referenced multiple times), but instead will emit a
187reference to the earlier value.
188
189This means that such values will only be encoded once, and will not result
190in a deep cloning of the value on decode, in decoders supporting the value
191sharing extension.
192
193It is recommended to leave it off unless you know your
194communication partner supports the value sharing extensions to CBOR
195(http://cbor.schmorp.de/value-sharing).
196
197Detecting shared values incurs a runtime overhead when values are encoded
198that have a reference counter large than one, and might unnecessarily
199increase the encoded size, as potentially shared values are encode as
200sharable whether or not they are actually shared.
201
202At the moment, only targets of references can be shared (e.g. scalars,
203arrays or hashes pointed to by a reference). Weirder constructs, such as
204an array with multiple "copies" of the I<same> string, which are hard but
205not impossible to create in Perl, are not supported (this is the same as
206for L<Storable>).
207
208If C<$enable> is false (the default), then C<encode> will encode
209exception when it encounters anything it cannot encode as CBOR.
210
211This option does not affect C<decode> in any way - shared values and
212references will always be decoded properly if present.
213
214=item $cbor = $cbor->allow_stringref ([$enable])
215
216=item $enabled = $cbor->get_allow_stringref
217
218If C<$enable> is true (or missing), then C<encode> will try not to encode
219the same string twice, but will instead encode a reference to the string
220instead. Depending on your data format. this can save a lot of space, but
221also results in a very large runtime overhead (expect encoding times to be
2222-4 times as high as without).
223
224It is recommended to leave it off unless you know your
225communications partner supports the stringref extension to CBOR
226(http://cbor.schmorp.de/stringref).
227
228If C<$enable> is false (the default), then C<encode> will encode
229exception when it encounters anything it cannot encode as CBOR.
230
231This option does not affect C<decode> in any way - string references will
232always be decoded properly if present.
233
234=item $cbor = $cbor->filter ([$cb->($tag, $value)])
235
236=item $cb_or_undef = $cbor->get_filter
237
238TODO
239
126=item $cbor_data = $cbor->encode ($perl_scalar) 240=item $cbor_data = $cbor->encode ($perl_scalar)
127 241
128Converts the given Perl data structure (a scalar value) to its CBOR 242Converts the given Perl data structure (a scalar value) to its CBOR
129representation. 243representation.
130 244
186 300
187CBOR arrays and CBOR maps will be converted into references to a Perl 301CBOR arrays and CBOR maps will be converted into references to a Perl
188array or hash, respectively. The keys of the map will be stringified 302array or hash, respectively. The keys of the map will be stringified
189during this process. 303during this process.
190 304
305=item null
306
307CBOR null becomes C<undef> in Perl.
308
191=item true, false 309=item true, false, undefined
192 310
193These CBOR values become C<CBOR::XS::true> and C<CBOR::XS::false>, 311These CBOR values become C<Types:Serialiser::true>,
312C<Types:Serialiser::false> and C<Types::Serialiser::error>,
194respectively. They are overloaded to act almost exactly like the numbers 313respectively. They are overloaded to act almost exactly like the numbers
195C<1> and C<0>. You can check whether a scalar is a CBOR boolean by using 314C<1> and C<0> (for true and false) or to throw an exception on access (for
196the C<CBOR::XS::is_bool> function. 315error). See the L<Types::Serialiser> manpage for details.
197 316
198=item null, undefined 317=item tagged values
199 318
200CBOR null and undefined values becomes C<undef> in Perl (in the future,
201Undefined may raise an exception or something else).
202
203=item tags
204
205Tagged items consists of a numeric tag and another CBOR value. The tag 319Tagged items consists of a numeric tag and another CBOR value.
20655799 is ignored (this tag implements the magic header).
207 320
208All other tags are currently converted into a L<CBOR::XS::Tagged> object, 321See L<TAG HANDLING AND EXTENSIONS> and the description of C<< ->filter >>
209which is simply a blessed array reference consistsing of the numeric tag 322for details.
210value followed by the (decoded) BOR value.
211 323
212=item anything else 324=item anything else
213 325
214Anything else (e.g. unsupported simple values) will raise a decoding 326Anything else (e.g. unsupported simple values) will raise a decoding
215error. 327error.
245C<1>, which get turned into false and true in CBOR. 357C<1>, which get turned into false and true in CBOR.
246 358
247=item CBOR::XS::Tagged objects 359=item CBOR::XS::Tagged objects
248 360
249Objects of this type must be arrays consisting of a single C<[tag, value]> 361Objects of this type must be arrays consisting of a single C<[tag, value]>
250pair. The (numerical) tag will be encoded as a CBOR tag, the value will be 362pair. The (numerical) tag will be encoded as a CBOR tag, the value will
251encoded as appropriate for the value. 363be encoded as appropriate for the value. You cna use C<CBOR::XS::tag> to
364create such objects.
252 365
253=item CBOR::XS::true, CBOR::XS::false 366=item Types::Serialiser::true, Types::Serialiser::false, Types::Serialiser::error
254 367
255These special values become CBOR true and CBOR false values, 368These special values become CBOR true, CBOR false and CBOR undefined
256respectively. You can also use C<\1> and C<\0> directly if you want. 369values, respectively. You can also use C<\1>, C<\0> and C<\undef> directly
370if you want.
257 371
258=item blessed objects 372=item other blessed objects
259 373
260Other blessed objects currently need to have a C<TO_CBOR> method. It 374Other blessed objects are serialised via C<TO_CBOR> or C<FREEZE>. See
261will be called on every object that is being serialised, and must return 375L<TAG HANDLING AND EXTENSIONS> for specific classes handled by this
262something that can be encoded in CBOR. 376module, and L<OBJECT SERIALISATION> for generic object serialisation.
263 377
264=item simple scalars 378=item simple scalars
265 379
266TODO
267Simple Perl scalars (any scalar that is not a reference) are the most 380Simple Perl scalars (any scalar that is not a reference) are the most
268difficult objects to encode: CBOR::XS will encode undefined scalars as 381difficult objects to encode: CBOR::XS will encode undefined scalars as
269CBOR null values, scalars that have last been used in a string context 382CBOR null values, scalars that have last been used in a string context
270before encoding as CBOR strings, and anything else as number value: 383before encoding as CBOR strings, and anything else as number value:
271 384
305represent numerical values are supported, but might suffer loss of 418represent numerical values are supported, but might suffer loss of
306precision. 419precision.
307 420
308=back 421=back
309 422
423=head2 OBJECT SERIALISATION
310 424
425This module knows two way to serialise a Perl object: The CBOR-specific
426way, and the generic way.
427
428Whenever the encoder encounters a Perl object that it cnanot serialise
429directly (most of them), it will first look up the C<TO_CBOR> method on
430it.
431
432If it has a C<TO_CBOR> method, it will call it with the object as only
433argument, and expects exactly one return value, which it will then
434substitute and encode it in the place of the object.
435
436Otherwise, it will look up the C<FREEZE> method. If it exists, it will
437call it with the object as first argument, and the constant string C<CBOR>
438as the second argument, to distinguish it from other serialisers.
439
440The C<FREEZE> method can return any number of values (i.e. zero or
441more). These will be encoded as CBOR perl object, together with the
442classname.
443
444If an object supports neither C<TO_CBOR> nor C<FREEZE>, encoding will fail
445with an error.
446
447Objects encoded via C<TO_CBOR> cannot be automatically decoded, but
448objects encoded via C<FREEZE> can be decoded using the following protocol:
449
450When an encoded CBOR perl object is encountered by the decoder, it will
451look up the C<THAW> method, by using the stored classname, and will fail
452if the method cannot be found.
453
454After the lookup it will call the C<THAW> method with the stored classname
455as first argument, the constant string C<CBOR> as second argument, and all
456values returned by C<FREEZE> as remaining arguments.
457
458=head4 EXAMPLES
459
460Here is an example C<TO_CBOR> method:
461
462 sub My::Object::TO_CBOR {
463 my ($obj) = @_;
464
465 ["this is a serialised My::Object object", $obj->{id}]
466 }
467
468When a C<My::Object> is encoded to CBOR, it will instead encode a simple
469array with two members: a string, and the "object id". Decoding this CBOR
470string will yield a normal perl array reference in place of the object.
471
472A more useful and practical example would be a serialisation method for
473the URI module. CBOR has a custom tag value for URIs, namely 32:
474
475 sub URI::TO_CBOR {
476 my ($self) = @_;
477 my $uri = "$self"; # stringify uri
478 utf8::upgrade $uri; # make sure it will be encoded as UTF-8 string
479 CBOR::XS::tagged 32, "$_[0]"
480 }
481
482This will encode URIs as a UTF-8 string with tag 32, which indicates an
483URI.
484
485Decoding such an URI will not (currently) give you an URI object, but
486instead a CBOR::XS::Tagged object with tag number 32 and the string -
487exactly what was returned by C<TO_CBOR>.
488
489To serialise an object so it can automatically be deserialised, you need
490to use C<FREEZE> and C<THAW>. To take the URI module as example, this
491would be a possible implementation:
492
493 sub URI::FREEZE {
494 my ($self, $serialiser) = @_;
495 "$self" # encode url string
496 }
497
498 sub URI::THAW {
499 my ($class, $serialiser, $uri) = @_;
500
501 $class->new ($uri)
502 }
503
504Unlike C<TO_CBOR>, multiple values can be returned by C<FREEZE>. For
505example, a C<FREEZE> method that returns "type", "id" and "variant" values
506would cause an invocation of C<THAW> with 5 arguments:
507
508 sub My::Object::FREEZE {
509 my ($self, $serialiser) = @_;
510
511 ($self->{type}, $self->{id}, $self->{variant})
512 }
513
514 sub My::Object::THAW {
515 my ($class, $serialiser, $type, $id, $variant) = @_;
516
517 $class-<new (type => $type, id => $id, variant => $variant)
518 }
519
520
311=head2 MAGIC HEADER 521=head1 MAGIC HEADER
312 522
313There is no way to distinguish CBOR from other formats 523There is no way to distinguish CBOR from other formats
314programmatically. To make it easier to distinguish CBOR from other 524programmatically. To make it easier to distinguish CBOR from other
315formats, the CBOR specification has a special "magic string" that can be 525formats, the CBOR specification has a special "magic string" that can be
316prepended to any CBOR string without changing it's meaning. 526prepended to any CBOR string without changing its meaning.
317 527
318This string is available as C<$CBOR::XS::MAGIC>. This module does not 528This string is available as C<$CBOR::XS::MAGIC>. This module does not
319prepend this string tot he CBOR data it generates, but it will ignroe it 529prepend this string to the CBOR data it generates, but it will ignore it
320if present, so users can prepend this string as a "file type" indicator as 530if present, so users can prepend this string as a "file type" indicator as
321required. 531required.
322 532
323 533
534=head1 THE CBOR::XS::Tagged CLASS
535
536CBOR has the concept of tagged values - any CBOR value can be tagged with
537a numeric 64 bit number, which are centrally administered.
538
539C<CBOR::XS> handles a few tags internally when en- or decoding. You can
540also create tags yourself by encoding C<CBOR::XS::Tagged> objects, and the
541decoder will create C<CBOR::XS::Tagged> objects itself when it hits an
542unknown tag.
543
544These objects are simply blessed array references - the first member of
545the array being the numerical tag, the second being the value.
546
547You can interact with C<CBOR::XS::Tagged> objects in the following ways:
548
549=over 4
550
551=item $tagged = CBOR::XS::tag $tag, $value
552
553This function(!) creates a new C<CBOR::XS::Tagged> object using the given
554C<$tag> (0..2**64-1) to tag the given C<$value> (which can be any Perl
555value that can be encoded in CBOR, including serialisable Perl objects and
556C<CBOR::XS::Tagged> objects).
557
558=item $tagged->[0]
559
560=item $tagged->[0] = $new_tag
561
562=item $tag = $tagged->tag
563
564=item $new_tag = $tagged->tag ($new_tag)
565
566Access/mutate the tag.
567
568=item $tagged->[1]
569
570=item $tagged->[1] = $new_value
571
572=item $value = $tagged->value
573
574=item $new_value = $tagged->value ($new_value)
575
576Access/mutate the tagged value.
577
578=back
579
580=cut
581
582sub tag($$) {
583 bless [@_], CBOR::XS::Tagged::;
584}
585
586sub CBOR::XS::Tagged::tag {
587 $_[0][0] = $_[1] if $#_;
588 $_[0][0]
589}
590
591sub CBOR::XS::Tagged::value {
592 $_[0][1] = $_[1] if $#_;
593 $_[0][1]
594}
595
596=head2 EXAMPLES
597
598Here are some examples of C<CBOR::XS::Tagged> uses to tag objects.
599
600You can look up CBOR tag value and emanings in the IANA registry at
601L<http://www.iana.org/assignments/cbor-tags/cbor-tags.xhtml>.
602
603Prepend a magic header (C<$CBOR::XS::MAGIC>):
604
605 my $cbor = encode_cbor CBOR::XS::tag 55799, $value;
606 # same as:
607 my $cbor = $CBOR::XS::MAGIC . encode_cbor $value;
608
609Serialise some URIs and a regex in an array:
610
611 my $cbor = encode_cbor [
612 (CBOR::XS::tag 32, "http://www.nethype.de/"),
613 (CBOR::XS::tag 32, "http://software.schmorp.de/"),
614 (CBOR::XS::tag 35, "^[Pp][Ee][Rr][lL]\$"),
615 ];
616
617Wrap CBOR data in CBOR:
618
619 my $cbor_cbor = encode_cbor
620 CBOR::XS::tag 24,
621 encode_cbor [1, 2, 3];
622
623=head1 TAG HANDLING AND EXTENSIONS
624
625This section describes how this module handles specific tagged values
626and extensions. If a tag is not mentioned here and no additional filters
627are provided for it, then the default handling applies (creating a
628CBOR::XS::Tagged object on decoding, and only encoding the tag when
629explicitly requested).
630
631Tags not handled specifically are currently converted into a
632L<CBOR::XS::Tagged> object, which is simply a blessed array reference
633consisting of the numeric tag value followed by the (decoded) CBOR value.
634
635Future versions of this module reserve the right to special case
636additional tags (such as base64url).
637
638=head2 ENFORCED TAGS
639
640These tags are always handled when decoding, and their handling cannot be
641overriden by the user.
642
643=over 4
644
645=item <unassigned> (perl-object, L<http://cbor.schmorp.de/perl-object>)
646
647These tags are automatically created (and decoded) for serialisable
648objects using the C<FREEZE/THAW> methods (the L<Types::Serialier> object
649serialisation protocol). See L<OBJECT SERIALISATION> for details.
650
651=item <unassigned>, <unassigned> (sharable, sharedref, L <http://cbor.schmorp.de/value-sharing>)
652
653These tags are automatically decoded when encountered, resulting in
654shared values in the decoded object. They are only encoded, however, when
655C<allow_sharable> is enabled.
656
657=item <unassigned>, <unassigned> (stringref-namespace, stringref, L <http://cbor.schmorp.de/stringref>)
658
659These tags are automatically decoded when encountered. They are only
660encoded, however, when C<allow_stringref> is enabled.
661
662=item 22098 (indirection, L<http://cbor.schmorp.de/indirection>)
663
664This tag is automatically generated when a reference are encountered (with
665the exception of hash and array refernces). It is converted to a reference
666when decoding.
667
668=item 55799 (self-describe CBOR, RFC 7049)
669
670This value is not generated on encoding (unless explicitly requested by
671the user), and is simply ignored when decoding.
672
673=back
674
675=head2 OPTIONAL TAGS
676
677These tags have default filters provided when decoding. Their handling can
678be overriden by changing the C<%CBOR::XS::FILTER> entry for the tag, or by
679providing a custom C<filter> function when decoding.
680
681When they result in decoding into a specific Perl class, the module
682usually provides a corresponding C<TO_CBOR> method as well.
683
684When any of these need to load additional modules that are not part of the
685perl core distribution (e.g. L<URI>), it is (currently) up to the user to
686provide these modules. The decoding usually fails with an exception if the
687required module cannot be loaded.
688
689=over 4
690
691=item 2, 3 (positive/negative bignum)
692
693These tags are decoded into L<Math::BigInt> objects. The corresponding
694C<Math::BigInt::TO_CBOR> method encodes "small" bigints into normal CBOR
695integers, and others into positive/negative CBOR bignums.
696
697=item 4, 5 (decimal fraction/bigfloat)
698
699Both decimal fractions and bigfloats are decoded into L<Math::BigFloat>
700objects. The corresponding C<Math::BigFloat::TO_CBOR> method I<always>
701encodes into a decimal fraction.
702
703CBOR cannot represent bigfloats with I<very> large exponents - conversion
704of such big float objects is undefined.
705
706Also, NaN and infinities are not encoded properly.
707
708=item 21, 22, 23 (expected later JSON conversion)
709
710CBOR::XS is not a CBOR-to-JSON converter, and will simply ignore these
711tags.
712
713=item 32 (URI)
714
715These objects decode into L<URI> objects. The corresponding
716C<URI::TO_CBOR> method again results in a CBOR URI value.
717
718=back
719
720=cut
721
722our %FILTER = (
723 # 0 # rfc4287 datetime, utf-8
724 # 1 # unix timestamp, any
725
726 2 => sub { # pos bigint
727 require Math::BigInt;
728 Math::BigInt->new ("0x" . unpack "H*", pop)
729 },
730
731 3 => sub { # neg bigint
732 require Math::BigInt;
733 -Math::BigInt->new ("0x" . unpack "H*", pop)
734 },
735
736 4 => sub { # decimal fraction, array
737 require Math::BigFloat;
738 Math::BigFloat->new ($_[1][1] . "E" . $_[1][0])
739 },
740
741 5 => sub { # bigfloat, array
742 require Math::BigFloat;
743 scalar Math::BigFloat->new ($_[1][1])->blsft ($_[1][0], 2)
744 },
745
746 21 => sub { pop }, # expected conversion to base64url encoding
747 22 => sub { pop }, # expected conversion to base64 encoding
748 23 => sub { pop }, # expected conversion to base16 encoding
749
750 # 24 # embedded cbor, byte string
751
752 32 => sub {
753 require URI;
754 URI->new (pop)
755 },
756
757 # 33 # base64url rfc4648, utf-8
758 # 34 # base64 rfc46484, utf-8
759 # 35 # regex pcre/ecma262, utf-8
760 # 36 # mime message rfc2045, utf-8
761);
762
763
324=head2 CBOR and JSON 764=head1 CBOR and JSON
325 765
326CBOR is supposed to implement a superset of the JSON data model, and is, 766CBOR is supposed to implement a superset of the JSON data model, and is,
327with some coercion, able to represent all JSON texts (something that other 767with some coercion, able to represent all JSON texts (something that other
328"binary JSON" formats such as BSON generally do not support). 768"binary JSON" formats such as BSON generally do not support).
329 769
409Please refrain from using rt.cpan.org or any other bug reporting 849Please refrain from using rt.cpan.org or any other bug reporting
410service. I put the contact address into my modules for a reason. 850service. I put the contact address into my modules for a reason.
411 851
412=cut 852=cut
413 853
414our $true = do { bless \(my $dummy = 1), "CBOR::XS::Boolean" }; 854our %FILTER = (
415our $false = do { bless \(my $dummy = 0), "CBOR::XS::Boolean" }; 855 # 0 # rfc4287 datetime, utf-8
856 # 1 # unix timestamp, any
416 857
417sub true() { $true } 858 2 => sub { # pos bigint
418sub false() { $false } 859 require Math::BigInt;
860 Math::BigInt->new ("0x" . unpack "H*", pop)
861 },
419 862
420sub is_bool($) { 863 3 => sub { # neg bigint
421 UNIVERSAL::isa $_[0], "CBOR::XS::Boolean" 864 require Math::BigInt;
422# or UNIVERSAL::isa $_[0], "CBOR::Literal" 865 -Math::BigInt->new ("0x" . unpack "H*", pop)
866 },
867
868 4 => sub { # decimal fraction, array
869 require Math::BigFloat;
870 Math::BigFloat->new ($_[1][1] . "E" . $_[1][0])
871 },
872
873 5 => sub { # bigfloat, array
874 require Math::BigFloat;
875 scalar Math::BigFloat->new ($_[1][1])->blsft ($_[1][0], 2)
876 },
877
878 21 => sub { pop }, # expected conversion to base64url encoding
879 22 => sub { pop }, # expected conversion to base64 encoding
880 23 => sub { pop }, # expected conversion to base16 encoding
881
882 # 24 # embedded cbor, byte string
883
884 32 => sub {
885 require URI;
886 URI->new (pop)
887 },
888
889 # 33 # base64url rfc4648, utf-8
890 # 34 # base64 rfc46484, utf-8
891 # 35 # regex pcre/ecma262, utf-8
892 # 36 # mime message rfc2045, utf-8
893);
894
895sub CBOR::XS::default_filter {
896 &{ $FILTER{$_[0]} or return }
423} 897}
424 898
899sub URI::TO_CBOR {
900 my $uri = $_[0]->as_string;
901 utf8::upgrade $uri;
902 CBOR::XS::tag 32, $uri
903}
904
905sub Math::BigInt::TO_CBOR {
906 if ($_[0] >= -2147483648 && $_[0] <= 2147483647) {
907 $_[0]->numify
908 } else {
909 my $hex = substr $_[0]->as_hex, 2;
910 $hex = "0$hex" if 1 & length $hex; # sigh
911 CBOR::XS::tag $_[0] >= 0 ? 2 : 3, pack "H*", $hex
912 }
913}
914
915sub Math::BigFloat::TO_CBOR {
916 my ($m, $e) = $_[0]->parts;
917 CBOR::XS::tag 4, [$e->numify, $m]
918}
919
425XSLoader::load "CBOR::XS", $VERSION; 920XSLoader::load "CBOR::XS", $VERSION;
426
427package CBOR::XS::Boolean;
428
429use overload
430 "0+" => sub { ${$_[0]} },
431 "++" => sub { $_[0] = ${$_[0]} + 1 },
432 "--" => sub { $_[0] = ${$_[0]} - 1 },
433 fallback => 1;
434
4351;
436 921
437=head1 SEE ALSO 922=head1 SEE ALSO
438 923
439The L<JSON> and L<JSON::XS> modules that do similar, but human-readable, 924The L<JSON> and L<JSON::XS> modules that do similar, but human-readable,
440serialisation. 925serialisation.
441 926
927The L<Types::Serialiser> module provides the data model for true, false
928and error values.
929
442=head1 AUTHOR 930=head1 AUTHOR
443 931
444 Marc Lehmann <schmorp@schmorp.de> 932 Marc Lehmann <schmorp@schmorp.de>
445 http://home.schmorp.de/ 933 http://home.schmorp.de/
446 934
447=cut 935=cut
448 936
9371
938

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines