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.31 by root, Sat Nov 30 18:13:53 2013 UTC vs.
Revision 1.36 by root, Mon Dec 2 06:37:53 2013 UTC

… …
64 64
65package CBOR::XS; 65package CBOR::XS;
66 66
67use common::sense; 67use common::sense;
68 68
69our $VERSION = '1.0'; 69our $VERSION = 1.11;
70our @ISA = qw(Exporter); 70our @ISA = qw(Exporter);
71 71
72our @EXPORT = qw(encode_cbor decode_cbor); 72our @EXPORT = qw(encode_cbor decode_cbor);
73 73
74use Exporter; 74use Exporter;
… …
241If C<$enable> is false (the default), then C<encode> will encode strings 241If C<$enable> is false (the default), then C<encode> will encode strings
242the standard CBOR way. 242the standard CBOR way.
243 243
244This option does not affect C<decode> in any way - string references will 244This option does not affect C<decode> in any way - string references will
245always be decoded properly if present. 245always be decoded properly if present.
246
247=item $cbor = $cbor->validate_utf8 ([$enable])
248
249=item $enabled = $cbor->get_validate_utf8
250
251If C<$enable> is true (or missing), then C<decode> will validate that
252elements (text strings) containing UTF-8 data in fact contain valid UTF-8
253data (instead of blindly accepting it). This validation obviously takes
254extra time during decoding.
255
256The concept of "valid UTF-8" used is perl's concept, which is a superset
257of the official UTF-8.
258
259If C<$enable> is false (the default), then C<decode> will blindly accept
260UTF-8 data, marking them as valid UTF-8 in the resulting data structure
261regardless of whether thats true or not.
262
263Perl isn't too happy about corrupted UTF-8 in strings, but should
264generally not crash or do similarly evil things. Extensions might be not
265so forgiving, so it's recommended to turn on this setting if you receive
266untrusted CBOR.
267
268This option does not affect C<encode> in any way - strings that are
269supposedly valid UTF-8 will simply be dumped into the resulting CBOR
270string without checking whether that is, in fact, true or not.
246 271
247=item $cbor = $cbor->filter ([$cb->($tag, $value)]) 272=item $cbor = $cbor->filter ([$cb->($tag, $value)])
248 273
249=item $cb_or_undef = $cbor->get_filter 274=item $cb_or_undef = $cbor->get_filter
250 275
… …
773perl core distribution (e.g. L<URI>), it is (currently) up to the user to 798perl core distribution (e.g. L<URI>), it is (currently) up to the user to
774provide these modules. The decoding usually fails with an exception if the 799provide these modules. The decoding usually fails with an exception if the
775required module cannot be loaded. 800required module cannot be loaded.
776 801
777=over 4 802=over 4
803
804=item 0, 1 (date/time string, seconds since the epoch)
805
806These tags are decoded into L<Time::Piece> objects. The corresponding
807C<Time::Piece::TO_CBOR> method always encodes into tag 1 values currently.
808
809The L<Time::Piece> API is generally surprisingly bad, and fractional
810seconds are only accidentally kept intact, so watch out. On the plus side,
811the module comes with perl since 5.10, which has to count for something.
778 812
779=item 2, 3 (positive/negative bignum) 813=item 2, 3 (positive/negative bignum)
780 814
781These tags are decoded into L<Math::BigInt> objects. The corresponding 815These tags are decoded into L<Math::BigInt> objects. The corresponding
782C<Math::BigInt::TO_CBOR> method encodes "small" bigints into normal CBOR 816C<Math::BigInt::TO_CBOR> method encodes "small" bigints into normal CBOR
… …
947service. I put the contact address into my modules for a reason. 981service. I put the contact address into my modules for a reason.
948 982
949=cut 983=cut
950 984
951our %FILTER = ( 985our %FILTER = (
952 # 0 # rfc4287 datetime, utf-8 986 0 => sub { # rfc4287 datetime, utf-8
953 # 1 # unix timestamp, any 987 require Time::Piece;
988 # Time::Piece::Strptime uses the "incredibly flexible date parsing routine"
989 # from FreeBSD, which can't parse ISO 8601, RFC3339, RFC4287 or much of anything
990 # else either. Whats incredibe over standard strptime totally escapes me.
991 # doesn't do fractional times, either. sigh.
992 # In fact, it's all a lie, it uses whatever strptime it wants, and of course,
993 # they are all incomptible. The openbsd one simply ignores %z (but according to the
994 # docs, it would be much more incredibly flexible).
995 scalar eval {
996 my $s = $_[1];
997
998 $s =~ s/Z$/+00:00/;
999 $s =~ s/(\.[0-9]+)?([+-][0-9][0-9]):([0-9][0-9])$//
1000 or die;
1001
1002 my $b = $1 - ($2 * 60 + $3) * 60; # fractional part + offset. hopefully
1003 my $d = Time::Piece->strptime ($s, "%Y-%m-%dT%H:%M:%S");
1004
1005 Time::Piece::gmtime ($d->epoch + $b)
1006 } || die "corrupted CBOR date/time string ($_[0])";
1007 },
1008
1009 1 => sub { # seconds since the epoch, possibly fractional
1010 require Time::Piece;
1011 scalar Time::Piece::gmtime (pop)
1012 },
954 1013
955 2 => sub { # pos bigint 1014 2 => sub { # pos bigint
956 require Math::BigInt; 1015 require Math::BigInt;
957 Math::BigInt->new ("0x" . unpack "H*", pop) 1016 Math::BigInt->new ("0x" . unpack "H*", pop)
958 }, 1017 },
… …
994} 1053}
995 1054
996sub URI::TO_CBOR { 1055sub URI::TO_CBOR {
997 my $uri = $_[0]->as_string; 1056 my $uri = $_[0]->as_string;
998 utf8::upgrade $uri; 1057 utf8::upgrade $uri;
999 CBOR::XS::tag 32, $uri 1058 tag 32, $uri
1000} 1059}
1001 1060
1002sub Math::BigInt::TO_CBOR { 1061sub Math::BigInt::TO_CBOR {
1003 if ($_[0] >= -2147483648 && $_[0] <= 2147483647) { 1062 if ($_[0] >= -2147483648 && $_[0] <= 2147483647) {
1004 $_[0]->numify 1063 $_[0]->numify
1005 } else { 1064 } else {
1006 my $hex = substr $_[0]->as_hex, 2; 1065 my $hex = substr $_[0]->as_hex, 2;
1007 $hex = "0$hex" if 1 & length $hex; # sigh 1066 $hex = "0$hex" if 1 & length $hex; # sigh
1008 CBOR::XS::tag $_[0] >= 0 ? 2 : 3, pack "H*", $hex 1067 tag $_[0] >= 0 ? 2 : 3, pack "H*", $hex
1009 } 1068 }
1010} 1069}
1011 1070
1012sub Math::BigFloat::TO_CBOR { 1071sub Math::BigFloat::TO_CBOR {
1013 my ($m, $e) = $_[0]->parts; 1072 my ($m, $e) = $_[0]->parts;
1014 CBOR::XS::tag 4, [$e->numify, $m] 1073 tag 4, [$e->numify, $m]
1074}
1075
1076sub Time::Piece::TO_CBOR {
1077 tag 1, $_[0]->epoch
1015} 1078}
1016 1079
1017XSLoader::load "CBOR::XS", $VERSION; 1080XSLoader::load "CBOR::XS", $VERSION;
1018 1081
1019=head1 SEE ALSO 1082=head1 SEE ALSO

Diff Legend

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