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.35 by root, Sun Dec 1 16:40:25 2013 UTC

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 scalar eval {
993 my $s = $_[1];
994
995 $s =~ s/Z$/+00:00/;
996 $s =~ s/(\.[0-9]+)?([+-][0-9][0-9]):([0-9][0-9])/$2$3/
997 or die;
998
999 my $f = $1; # fractional part. hopefully
1000
1001 my $d = Time::Piece->strptime ($s, "%Y-%m-%dT%H:%M:%S%z");
1002
1003 Time::Piece::gmtime ($d->epoch + $f)
1004 } || die "corrupted CBOR date/time string ($_[0])";
1005 },
1006
1007 1 => sub { # seconds since the epoch, possibly fractional
1008 require Time::Piece;
1009 scalar Time::Piece::gmtime (pop)
1010 },
979 1011
980 2 => sub { # pos bigint 1012 2 => sub { # pos bigint
981 require Math::BigInt; 1013 require Math::BigInt;
982 Math::BigInt->new ("0x" . unpack "H*", pop) 1014 Math::BigInt->new ("0x" . unpack "H*", pop)
983 }, 1015 },
1019} 1051}
1020 1052
1021sub URI::TO_CBOR { 1053sub URI::TO_CBOR {
1022 my $uri = $_[0]->as_string; 1054 my $uri = $_[0]->as_string;
1023 utf8::upgrade $uri; 1055 utf8::upgrade $uri;
1024 CBOR::XS::tag 32, $uri 1056 tag 32, $uri
1025} 1057}
1026 1058
1027sub Math::BigInt::TO_CBOR { 1059sub Math::BigInt::TO_CBOR {
1028 if ($_[0] >= -2147483648 && $_[0] <= 2147483647) { 1060 if ($_[0] >= -2147483648 && $_[0] <= 2147483647) {
1029 $_[0]->numify 1061 $_[0]->numify
1030 } else { 1062 } else {
1031 my $hex = substr $_[0]->as_hex, 2; 1063 my $hex = substr $_[0]->as_hex, 2;
1032 $hex = "0$hex" if 1 & length $hex; # sigh 1064 $hex = "0$hex" if 1 & length $hex; # sigh
1033 CBOR::XS::tag $_[0] >= 0 ? 2 : 3, pack "H*", $hex 1065 tag $_[0] >= 0 ? 2 : 3, pack "H*", $hex
1034 } 1066 }
1035} 1067}
1036 1068
1037sub Math::BigFloat::TO_CBOR { 1069sub Math::BigFloat::TO_CBOR {
1038 my ($m, $e) = $_[0]->parts; 1070 my ($m, $e) = $_[0]->parts;
1039 CBOR::XS::tag 4, [$e->numify, $m] 1071 tag 4, [$e->numify, $m]
1072}
1073
1074sub Time::Piece::TO_CBOR {
1075 tag 1, $_[0]->epoch
1040} 1076}
1041 1077
1042XSLoader::load "CBOR::XS", $VERSION; 1078XSLoader::load "CBOR::XS", $VERSION;
1043 1079
1044=head1 SEE ALSO 1080=head1 SEE ALSO

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines