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.34 by root, Sun Dec 1 14:48:00 2013 UTC vs.
Revision 1.38 by root, Tue Dec 3 10:23:55 2013 UTC

… …
64 64
65package CBOR::XS; 65package CBOR::XS;
66 66
67use common::sense; 67use common::sense;
68 68
69our $VERSION = 1.11; 69our $VERSION = 1.12;
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;
… …
798perl 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
799provide these modules. The decoding usually fails with an exception if the 799provide these modules. The decoding usually fails with an exception if the
800required module cannot be loaded. 800required module cannot be loaded.
801 801
802=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.
803 812
804=item 2, 3 (positive/negative bignum) 813=item 2, 3 (positive/negative bignum)
805 814
806These tags are decoded into L<Math::BigInt> objects. The corresponding 815These tags are decoded into L<Math::BigInt> objects. The corresponding
807C<Math::BigInt::TO_CBOR> method encodes "small" bigints into normal CBOR 816C<Math::BigInt::TO_CBOR> method encodes "small" bigints into normal CBOR
… …
972service. I put the contact address into my modules for a reason. 981service. I put the contact address into my modules for a reason.
973 982
974=cut 983=cut
975 984
976our %FILTER = ( 985our %FILTER = (
977 # 0 # rfc4287 datetime, utf-8 986 0 => sub { # rfc4287 datetime, utf-8
978 # 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 indeed. If it worked, that is.).
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 },
979 1013
980 2 => sub { # pos bigint 1014 2 => sub { # pos bigint
981 require Math::BigInt; 1015 require Math::BigInt;
982 Math::BigInt->new ("0x" . unpack "H*", pop) 1016 Math::BigInt->new ("0x" . unpack "H*", pop)
983 }, 1017 },
… …
1019} 1053}
1020 1054
1021sub URI::TO_CBOR { 1055sub URI::TO_CBOR {
1022 my $uri = $_[0]->as_string; 1056 my $uri = $_[0]->as_string;
1023 utf8::upgrade $uri; 1057 utf8::upgrade $uri;
1024 CBOR::XS::tag 32, $uri 1058 tag 32, $uri
1025} 1059}
1026 1060
1027sub Math::BigInt::TO_CBOR { 1061sub Math::BigInt::TO_CBOR {
1028 if ($_[0] >= -2147483648 && $_[0] <= 2147483647) { 1062 if ($_[0] >= -2147483648 && $_[0] <= 2147483647) {
1029 $_[0]->numify 1063 $_[0]->numify
1030 } else { 1064 } else {
1031 my $hex = substr $_[0]->as_hex, 2; 1065 my $hex = substr $_[0]->as_hex, 2;
1032 $hex = "0$hex" if 1 & length $hex; # sigh 1066 $hex = "0$hex" if 1 & length $hex; # sigh
1033 CBOR::XS::tag $_[0] >= 0 ? 2 : 3, pack "H*", $hex 1067 tag $_[0] >= 0 ? 2 : 3, pack "H*", $hex
1034 } 1068 }
1035} 1069}
1036 1070
1037sub Math::BigFloat::TO_CBOR { 1071sub Math::BigFloat::TO_CBOR {
1038 my ($m, $e) = $_[0]->parts; 1072 my ($m, $e) = $_[0]->parts;
1039 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
1040} 1078}
1041 1079
1042XSLoader::load "CBOR::XS", $VERSION; 1080XSLoader::load "CBOR::XS", $VERSION;
1043 1081
1044=head1 SEE ALSO 1082=head1 SEE ALSO

Diff Legend

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