Rev 30 | Blame | Compare with Previous | Last modification | View Log | RSS feed
(*Licensed to the Apache Software Foundation (ASF) under oneor more contributor license agreements. See the NOTICE filedistributed with this work for additional informationregarding copyright ownership. The ASF licenses this fileto you under the Apache License, Version 2.0 (the"License"); you may not use this file except in compliancewith the License. You may obtain a copy of the License athttp://www.apache.org/licenses/LICENSE-2.0Unless required by applicable law or agreed to in writing,software distributed under the License is distributed on an"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANYKIND, either express or implied. See the License for thespecific language governing permissions and limitationsunder the License.*)open Thriftmodule P = Protocollet get_byte i b = 255 land (i lsr (8*b))let get_byte64 i b = 255 land (Int64.to_int (Int64.shift_right i (8*b)))let tv = P.t_type_to_ilet vt = P.t_type_of_ilet comp_int b n =let s = ref 0l inlet sb = 32 - 8*n infor i=0 to (n-1) dos:= Int32.logor !s (Int32.shift_left (Int32.of_int (int_of_char b.[i])) (8*(n-1-i)))done;Int32.to_int (Int32.shift_right (Int32.shift_left !s sb) sb)let comp_int64 b n =let s = ref 0L infor i=0 to (n-1) dos:=Int64.logor !s (Int64.shift_left (Int64.of_int (int_of_char b.[i])) (8*(n-1-i)))done;!slet version_mask = 0xffff0000let version_1 = 0x80010000class t trans =object (self)inherit P.t transval ibyte = String.create 8method writeBool b =ibyte.[0] <- char_of_int (if b then 1 else 0);trans#write ibyte 0 1method writeByte i =ibyte.[0] <- char_of_int (get_byte i 0);trans#write ibyte 0 1method writeI16 i =let gb = get_byte i inibyte.[1] <- char_of_int (gb 0);ibyte.[0] <- char_of_int (gb 1);trans#write ibyte 0 2method writeI32 i =let gb = get_byte i infor i=0 to 3 doibyte.[3-i] <- char_of_int (gb i)done;trans#write ibyte 0 4method writeI64 i=let gb = get_byte64 i infor i=0 to 7 doibyte.[7-i] <- char_of_int (gb i)done;trans#write ibyte 0 8method writeDouble d =self#writeI64 (Int64.bits_of_float d)method writeString s=let n = String.length s inself#writeI32(n);trans#write s 0 nmethod writeBinary a = self#writeString amethod writeMessageBegin (n,t,s) =self#writeI32 (version_1 lor (P.message_type_to_i t));self#writeString n;self#writeI32 smethod writeMessageEnd = ()method writeStructBegin s = ()method writeStructEnd = ()method writeFieldBegin (n,t,i) =self#writeByte (tv t);self#writeI16 imethod writeFieldEnd = ()method writeFieldStop =self#writeByte (tv (Protocol.T_STOP))method writeMapBegin (k,v,s) =self#writeByte (tv k);self#writeByte (tv v);self#writeI32 smethod writeMapEnd = ()method writeListBegin (t,s) =self#writeByte (tv t);self#writeI32 smethod writeListEnd = ()method writeSetBegin (t,s) =self#writeByte (tv t);self#writeI32 smethod writeSetEnd = ()method readByte =ignore (trans#readAll ibyte 0 1);(comp_int ibyte 1)method readI16 =ignore (trans#readAll ibyte 0 2);comp_int ibyte 2method readI32 =ignore (trans#readAll ibyte 0 4);comp_int ibyte 4method readI64 =ignore (trans#readAll ibyte 0 8);comp_int64 ibyte 8method readDouble =Int64.float_of_bits (self#readI64)method readBool =self#readByte = 1method readString =let sz = self#readI32 inlet buf = String.create sz inignore (trans#readAll buf 0 sz);bufmethod readBinary = self#readStringmethod readMessageBegin =let ver = self#readI32 inif (ver land version_mask != version_1) then(print_int ver;raise (P.E (P.BAD_VERSION, "Missing version identifier")))elselet s = self#readString inlet mt = P.message_type_of_i (ver land 0xFF) in(s,mt, self#readI32)method readMessageEnd = ()method readStructBegin =""method readStructEnd = ()method readFieldBegin =let t = (vt (self#readByte))inif t != P.T_STOP then("",t,self#readI16)else ("",t,0);method readFieldEnd = ()method readMapBegin =let kt = vt (self#readByte) inlet vt = vt (self#readByte) in(kt,vt, self#readI32)method readMapEnd = ()method readListBegin =let t = vt (self#readByte) in(t,self#readI32)method readListEnd = ()method readSetBegin =let t = vt (self#readByte) in(t, self#readI32);method readSetEnd = ()endclass factory =objectinherit P.factorymethod getProtocol tr = new t trend