1##
2## Warning, despite name of the file, subrotines from here belongs
3## to Google::ProtocolBuffers::Codec namespace
4##
5package Google::ProtocolBuffers::Codec;
6use strict;
7use warnings FATAL => 'substr';
8use Math::BigInt;
9use constant TWO_IN_64  => Math::BigInt->new("0x1_0000_0000_0000_0000");
10use constant MAX_SINT64 => Math::BigInt->new(  "0x7FFF_FFFF_FFFF_FFFF");
11
12
13## Signature of all encode_* subs:
14##      encode_*($buffer, $value);
15## Encoded value of $value will be appended to $buffer, which is a string
16## passed by reference. No meaningfull value is returned, in case of errors
17## an exception it thrown.
18##
19## Signature of all encode_* subs:
20##      my $value = decode_*($buffer, $position);
21## $buffer is a string passed by reference, no copy is performed and it
22## is not modified. $position is a number variable passed by reference
23## (index in the string $buffer where to start decoding of a value), it
24## is incremented by decode_* subs. In case of errors an exception is
25## thrown.
26
27sub decode_varint {
28    my $v = 0;
29    my $shift = 0;
30    my $l = length($_[0]);
31    while (1) {
32        die BROKEN_MESSAGE() if $_[1] >= $l; ## if $_[1]+1 > $l
33        my $b = ord(substr($_[0], $_[1]++, 1));
34        if ($shift==28) {
35            $shift = Math::BigInt->new($shift);
36        }
37        $v += (($b & 0x7F) << $shift);
38        $shift += 7;
39        last if ($b & 0x80)==0;
40        die "Number is too long" if $shift > 63;
41    }
42    return $v;
43}
44
45sub encode_int {
46    if ($_[1]>=0) {
47        encode_varint($_[0], $_[1]);
48    } else {
49        ## We need a positive 64 bit integer, which bit representation is
50        ## the same as of this negative value, static_cast<uint64>(int64).
51        ## 2^64 + $v === (2^64-1) + $v + 1, for $v<0
52        encode_varint($_[0], (TWO_IN_64+$_[1]));
53    }
54}
55
56sub decode_int {
57    my $v = decode_varint(@_);
58    if ($v>MAX_SINT64) {
59        return ($v - TWO_IN_64);
60    } else {
61        return $v;
62    }
63}
64
65##
66## $_[1]<<1 is subject to overflow: a value that fit into
67## Perl's int (IV) may need unsigned int (UV) to fit,
68## and I don't know how to make Perl do that cast.
69##
70sub encode_sint {
71    if ($_[1]>=MAX_SINT32()) {
72        encode_varint($_[0], Math::BigInt->new($_[1])<<1);
73    } elsif ($_[1]<=MIN_SINT32()) {
74        encode_varint($_[0], ((-Math::BigInt->new($_[1]))<<1)-1);
75    } elsif ($_[1]>=0) {
76        encode_varint($_[0], $_[1]<<1);
77    } else {
78        encode_varint($_[0], ((-$_[1])<<1)-1);
79    }
80}
81
82sub encode_fixed64 {
83    $_[0] .= pack('V', $_[1] & 0xFFFF_FFFF);
84    $_[0] .= pack('V', ($_[1]>>16)>>16);
85}
86sub decode_fixed64 {
87    die BROKEN_MESSAGE() if $_[1]+8 > length($_[0]);
88    my $a = unpack('V', substr($_[0], $_[1],   4));
89    my $b = unpack('V', substr($_[0], $_[1]+4, 4));
90    $_[1] += 8;
91    if ($b==0) {
92        return $a
93    } else {
94        $b = Math::BigInt->new($b);
95        return $a | ($b<<32);
96    }
97}
98
99sub encode_sfixed64 {
100    if ($_[1]>=0) {
101        $_[0] .= pack('V', $_[1] & 0xFFFF_FFFF);
102        $_[0] .= pack('V', ($_[1]>>16)>>16);
103    } else {
104        ## We need a positive 64 bit integer, which bit representation is
105        ## the same as of this negative value, static_cast<uint64>(int64).
106        ## 2^64 + $v === (2^64-1) + $v + 1, for $v<0
107        my $v = (TWO_IN_64+$_[1]);
108        $_[0] .= pack('V', $v & 0xFFFF_FFFF);
109        $_[0] .= pack('V', ($v>>16)>>16);
110    }
111
112}
113
114sub decode_sfixed64 {
115    die BROKEN_MESSAGE() if $_[1]+8 > length($_[0]);
116    my $a = unpack('V', substr($_[0], $_[1],   4));
117    my $b = unpack('V', substr($_[0], $_[1]+4, 4));
118    $_[1] += 8;
119    if ($b==0) {
120        return $a;
121    } else {
122        $b = (Math::BigInt->new($b)<<32) | $a;
123        return ($b>MAX_SINT64()) ? $b-TWO_IN_64() : $b;
124    }
125}
126
1271;
128