1"
2Licensed to the Apache Software Foundation (ASF) under one
3or more contributor license agreements. See the NOTICE file
4distributed with this work for additional information
5regarding copyright ownership. The ASF licenses this file
6to you under the Apache License, Version 2.0 (the
7License); you may not use this file except in compliance
8with the License. You may obtain a copy of the License at
9
10  http://www.apache.org/licenses/LICENSE-2.0
11
12Unless required by applicable law or agreed to in writing,
13software distributed under the License is distributed on an
14AS IS BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
15KIND, either express or implied. See the License for the
16specific language governing permissions and limitations
17under the License.
18
19Contains some contributions under the Thrift Software License.
20Please see doc/old-thrift-license.txt in the Thrift distribution for
21details.
22"
23
24SystemOrganization addCategory: #Thrift!
25SystemOrganization addCategory: #'Thrift-Protocol'!
26SystemOrganization addCategory: #'Thrift-Transport'!
27
28Error subclass: #TError
29	instanceVariableNames: 'code'
30	classVariableNames: ''
31	poolDictionaries: ''
32	category: 'Thrift'!
33
34!TError class methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 17:28'!
35signalWithCode: anInteger
36	self new code: anInteger; signal! !
37
38!TError methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 17:28'!
39code
40	^ code! !
41
42!TError methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 17:28'!
43code: anInteger
44	code := anInteger! !
45
46TError subclass: #TProtocolError
47	instanceVariableNames: ''
48	classVariableNames: ''
49	poolDictionaries: ''
50	category: 'Thrift-Protocol'!
51
52!TProtocolError class methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 18:39'!
53badVersion
54	^ 4! !
55
56!TProtocolError class methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 18:39'!
57invalidData
58	^ 1! !
59
60!TProtocolError class methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 18:39'!
61negativeSize
62	^ 2! !
63
64!TProtocolError class methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 18:40'!
65sizeLimit
66	^ 3! !
67
68!TProtocolError class methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 18:40'!
69unknown
70	^ 0! !
71
72TError subclass: #TTransportError
73	instanceVariableNames: ''
74	classVariableNames: ''
75	poolDictionaries: ''
76	category: 'Thrift-Transport'!
77
78TTransportError subclass: #TTransportClosedError
79	instanceVariableNames: ''
80	classVariableNames: ''
81	poolDictionaries: ''
82	category: 'Thrift-Transport'!
83
84Object subclass: #TClient
85	instanceVariableNames: 'iprot oprot seqid remoteSeqid'
86	classVariableNames: ''
87	poolDictionaries: ''
88	category: 'Thrift'!
89
90!TClient class methodsFor: 'as yet unclassified' stamp: 'pc 11/7/2007 06:00'!
91binaryOnHost: aString port: anInteger
92	| sock |
93	sock := TSocket new host: aString; port: anInteger; open; yourself.
94	^ self new
95		inProtocol: (TBinaryProtocol new transport: sock);
96		yourself! !
97
98!TClient methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 23:03'!
99inProtocol: aProtocol
100	iprot := aProtocol.
101	oprot ifNil: [oprot := aProtocol]! !
102
103!TClient methodsFor: 'as yet unclassified' stamp: 'pc 10/26/2007 04:28'!
104nextSeqid
105	^ seqid
106		ifNil: [seqid := 0]
107		ifNotNil: [seqid := seqid + 1]! !
108
109!TClient methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 22:51'!
110outProtocol: aProtocol
111	oprot := aProtocol! !
112
113!TClient methodsFor: 'as yet unclassified' stamp: 'pc 10/28/2007 15:32'!
114validateRemoteMessage: aMsg
115	remoteSeqid
116		ifNil: [remoteSeqid := aMsg seqid]
117		ifNotNil:
118			[(remoteSeqid + 1) = aMsg seqid ifFalse:
119				[TProtocolError signal: 'Bad seqid: ', aMsg seqid asString,
120							'; wanted: ', remoteSeqid asString].
121			remoteSeqid := aMsg seqid]! !
122
123Object subclass: #TField
124	instanceVariableNames: 'name type id'
125	classVariableNames: ''
126	poolDictionaries: ''
127	category: 'Thrift-Protocol'!
128
129!TField methodsFor: 'accessing' stamp: 'pc 10/24/2007 20:05'!
130id
131	^ id ifNil: [0]! !
132
133!TField methodsFor: 'accessing' stamp: 'pc 10/24/2007 19:44'!
134id: anInteger
135	id := anInteger! !
136
137!TField methodsFor: 'accessing' stamp: 'pc 10/24/2007 20:04'!
138name
139	^ name ifNil: ['']! !
140
141!TField methodsFor: 'accessing' stamp: 'pc 10/24/2007 19:44'!
142name: anObject
143	name := anObject! !
144
145!TField methodsFor: 'accessing' stamp: 'pc 10/24/2007 20:05'!
146type
147	^ type ifNil: [TType stop]! !
148
149!TField methodsFor: 'accessing' stamp: 'pc 10/24/2007 19:44'!
150type: anInteger
151	type := anInteger! !
152
153Object subclass: #TMessage
154	instanceVariableNames: 'name seqid type'
155	classVariableNames: ''
156	poolDictionaries: ''
157	category: 'Thrift-Protocol'!
158
159TMessage subclass: #TCallMessage
160	instanceVariableNames: ''
161	classVariableNames: ''
162	poolDictionaries: ''
163	category: 'Thrift-Protocol'!
164
165!TCallMessage methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 22:53'!
166type
167	^ 1! !
168
169!TMessage methodsFor: 'accessing' stamp: 'pc 10/24/2007 20:05'!
170name
171	^ name ifNil: ['']! !
172
173!TMessage methodsFor: 'accessing' stamp: 'pc 10/24/2007 19:35'!
174name: aString
175	name := aString! !
176
177!TMessage methodsFor: 'accessing' stamp: 'pc 10/24/2007 20:05'!
178seqid
179	^ seqid ifNil: [0]! !
180
181!TMessage methodsFor: 'accessing' stamp: 'pc 10/24/2007 19:35'!
182seqid: anInteger
183	seqid := anInteger! !
184
185!TMessage methodsFor: 'accessing' stamp: 'pc 10/24/2007 20:06'!
186type
187	^ type ifNil: [0]! !
188
189!TMessage methodsFor: 'accessing' stamp: 'pc 10/24/2007 19:35'!
190type: anInteger
191	type := anInteger! !
192
193Object subclass: #TProtocol
194	instanceVariableNames: 'transport'
195	classVariableNames: ''
196	poolDictionaries: ''
197	category: 'Thrift-Protocol'!
198
199TProtocol subclass: #TBinaryProtocol
200	instanceVariableNames: ''
201	classVariableNames: ''
202	poolDictionaries: ''
203	category: 'Thrift-Protocol'!
204
205!TBinaryProtocol methodsFor: 'reading' stamp: 'pc 11/1/2007 04:24'!
206intFromByteArray: buf
207	| vals |
208	vals := Array new: buf size.
209	1 to: buf size do: [:n | vals at: n put: ((buf at: n) bitShift: (buf size - n) * 8)].
210	^ vals sum! !
211
212!TBinaryProtocol methodsFor: 'reading' stamp: 'pc 10/24/2007 18:46'!
213readBool
214	^ self readByte isZero not! !
215
216!TBinaryProtocol methodsFor: 'reading' stamp: 'pc 10/25/2007 00:02'!
217readByte
218	^ (self transport read: 1) first! !
219
220!TBinaryProtocol methodsFor: 'reading' stamp: 'pc 10/28/2007 16:24'!
221readDouble
222	| val |
223	val := Float new: 2.
224	^ val basicAt: 1 put: (self readRawInt: 4);
225		basicAt: 2 put: (self readRawInt: 4);
226		yourself! !
227
228!TBinaryProtocol methodsFor: 'reading' stamp: 'pc 10/24/2007 20:02'!
229readFieldBegin
230	| field |
231	field := TField new type: self readByte.
232
233	^ field type = TType stop
234		ifTrue: [field]
235		ifFalse: [field id: self readI16; yourself]! !
236
237!TBinaryProtocol methodsFor: 'reading' stamp: 'pc 10/24/2007 19:15'!
238readI16
239	^ self readInt: 2! !
240
241!TBinaryProtocol methodsFor: 'reading' stamp: 'pc 10/24/2007 19:20'!
242readI32
243	^ self readInt: 4! !
244
245!TBinaryProtocol methodsFor: 'reading' stamp: 'pc 10/24/2007 19:20'!
246readI64
247	^ self readInt: 8! !
248
249!TBinaryProtocol methodsFor: 'reading' stamp: 'pc 11/1/2007 02:35'!
250readInt: size
251	| buf val |
252	buf := transport read: size.
253	val := self intFromByteArray: buf.
254	^ buf first > 16r7F
255		ifTrue: [self unsignedInt: val size: size]
256		ifFalse: [val]! !
257
258!TBinaryProtocol methodsFor: 'reading' stamp: 'pc 10/24/2007 19:57'!
259readListBegin
260	^ TList new
261		elemType: self readByte;
262		size: self readI32! !
263
264!TBinaryProtocol methodsFor: 'reading' stamp: 'pc 10/24/2007 19:58'!
265readMapBegin
266	^ TMap new
267		keyType: self readByte;
268		valueType: self readByte;
269		size: self readI32! !
270
271!TBinaryProtocol methodsFor: 'reading' stamp: 'pc 11/1/2007 04:22'!
272readMessageBegin
273	| version |
274	version := self readI32.
275
276	(version bitAnd: self versionMask) = self version1
277		ifFalse: [TProtocolError signalWithCode: TProtocolError badVersion].
278
279	^ TMessage new
280		type: (version bitAnd: 16r000000FF);
281		name: self readString;
282		seqid: self readI32! !
283
284!TBinaryProtocol methodsFor: 'reading' stamp: 'pc 10/28/2007 16:24'!
285readRawInt: size
286	^ self intFromByteArray: (transport read: size)! !
287
288!TBinaryProtocol methodsFor: 'reading' stamp: 'pc 11/1/2007 00:59'!
289readSetBegin
290	"element type, size"
291	^ TSet new
292		elemType: self readByte;
293		size: self readI32! !
294
295!TBinaryProtocol methodsFor: 'reading' stamp: 'pc 02/07/2009 19:00'!
296readString
297	| sz |
298	sz := self readI32.
299	^ sz > 0 ifTrue: [(transport read: sz) asString] ifFalse: ['']! !
300
301!TBinaryProtocol methodsFor: 'reading' stamp: 'pc 11/1/2007 04:22'!
302unsignedInt: val size: size
303	^ 0 - ((val - 1) bitXor: ((2 raisedTo: (size * 8)) - 1))! !
304
305!TBinaryProtocol methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 22:13'!
306version1
307	^ 16r80010000 ! !
308
309!TBinaryProtocol methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 18:01'!
310versionMask
311	^ 16rFFFF0000! !
312
313!TBinaryProtocol methodsFor: 'writing' stamp: 'pc 10/24/2007 18:35'!
314write: aString
315	transport write: aString! !
316
317!TBinaryProtocol methodsFor: 'writing' stamp: 'pc 10/24/2007 19:23'!
318writeBool: bool
319	bool ifTrue: [self writeByte: 1]
320		ifFalse: [self writeByte: 0]! !
321
322!TBinaryProtocol methodsFor: 'writing' stamp: 'pc 10/26/2007 09:31'!
323writeByte: aNumber
324	aNumber > 16rFF ifTrue: [TError signal: 'writeByte too big'].
325	transport write: (Array with: aNumber)! !
326
327!TBinaryProtocol methodsFor: 'writing' stamp: 'pc 10/28/2007 16:16'!
328writeDouble: aDouble
329	self writeI32: (aDouble basicAt: 1);
330		writeI32: (aDouble basicAt: 2)! !
331
332!TBinaryProtocol methodsFor: 'writing' stamp: 'pc 10/24/2007 19:56'!
333writeField: aField
334	self writeByte: aField type;
335		writeI16: aField id! !
336
337!TBinaryProtocol methodsFor: 'writing' stamp: 'pc 10/25/2007 00:01'!
338writeFieldBegin: aField
339	self writeByte: aField type.
340	self writeI16: aField id! !
341
342!TBinaryProtocol methodsFor: 'writing' stamp: 'pc 10/24/2007 18:04'!
343writeFieldStop
344	self writeByte: TType stop! !
345
346!TBinaryProtocol methodsFor: 'writing' stamp: 'pc 11/1/2007 02:06'!
347writeI16: i16
348	self writeInt: i16 size: 2! !
349
350!TBinaryProtocol methodsFor: 'writing' stamp: 'pc 11/1/2007 02:06'!
351writeI32: i32
352	self writeInt: i32 size: 4! !
353
354!TBinaryProtocol methodsFor: 'writing' stamp: 'pc 11/1/2007 02:06'!
355writeI64: i64
356	self writeInt: i64 size: 8! !
357
358!TBinaryProtocol methodsFor: 'writing' stamp: 'pc 11/1/2007 04:23'!
359writeInt: val size: size
360	1 to: size do: [:n | self writeByte: ((val bitShift: (size negated + n) * 8) bitAnd: 16rFF)]! !
361
362!TBinaryProtocol methodsFor: 'writing' stamp: 'pc 11/1/2007 00:48'!
363writeListBegin: aList
364	self writeByte: aList elemType; writeI32: aList size! !
365
366!TBinaryProtocol methodsFor: 'writing' stamp: 'pc 10/24/2007 19:55'!
367writeMapBegin: aMap
368	self writeByte: aMap keyType;
369		writeByte: aMap valueType;
370		writeI32: aMap size! !
371
372!TBinaryProtocol methodsFor: 'writing' stamp: 'pc 10/24/2007 20:36'!
373writeMessageBegin: msg
374	self writeI32: (self version1 bitOr: msg type);
375		writeString: msg name;
376		writeI32: msg seqid! !
377
378!TBinaryProtocol methodsFor: 'writing' stamp: 'pc 11/1/2007 00:56'!
379writeSetBegin: aSet
380	self writeByte: aSet elemType; writeI32: aSet size! !
381
382!TBinaryProtocol methodsFor: 'writing' stamp: 'pc 10/24/2007 18:35'!
383writeString: aString
384	self writeI32: aString size;
385		write: aString! !
386
387!TProtocol methodsFor: 'reading' stamp: 'pc 10/24/2007 19:40'!
388readBool! !
389
390!TProtocol methodsFor: 'reading' stamp: 'pc 10/24/2007 19:40'!
391readByte! !
392
393!TProtocol methodsFor: 'reading' stamp: 'pc 10/24/2007 19:40'!
394readDouble! !
395
396!TProtocol methodsFor: 'reading' stamp: 'pc 10/24/2007 19:40'!
397readFieldBegin! !
398
399!TProtocol methodsFor: 'reading' stamp: 'pc 10/24/2007 19:40'!
400readFieldEnd! !
401
402!TProtocol methodsFor: 'reading' stamp: 'pc 10/24/2007 19:40'!
403readI16! !
404
405!TProtocol methodsFor: 'reading' stamp: 'pc 10/24/2007 19:40'!
406readI32! !
407
408!TProtocol methodsFor: 'reading' stamp: 'pc 10/24/2007 19:40'!
409readI64! !
410
411!TProtocol methodsFor: 'reading' stamp: 'pc 10/24/2007 19:40'!
412readListBegin! !
413
414!TProtocol methodsFor: 'reading' stamp: 'pc 10/24/2007 19:40'!
415readListEnd! !
416
417!TProtocol methodsFor: 'reading' stamp: 'pc 10/24/2007 19:40'!
418readMapBegin! !
419
420!TProtocol methodsFor: 'reading' stamp: 'pc 10/24/2007 19:40'!
421readMapEnd! !
422
423!TProtocol methodsFor: 'reading' stamp: 'pc 10/24/2007 19:39'!
424readMessageBegin! !
425
426!TProtocol methodsFor: 'reading' stamp: 'pc 10/24/2007 19:39'!
427readMessageEnd! !
428
429!TProtocol methodsFor: 'reading' stamp: 'pc 10/24/2007 19:40'!
430readSetBegin! !
431
432!TProtocol methodsFor: 'reading' stamp: 'pc 10/24/2007 19:40'!
433readSetEnd! !
434
435!TProtocol methodsFor: 'reading' stamp: 'pc 10/25/2007 16:10'!
436readSimpleType: aType
437	aType = TType bool ifTrue: [^ self readBool].
438	aType = TType byte ifTrue: [^ self readByte].
439	aType = TType double ifTrue: [^ self readDouble].
440	aType = TType i16 ifTrue: [^ self readI16].
441	aType = TType i32 ifTrue: [^ self readI32].
442	aType = TType i64 ifTrue: [^ self readI64].
443	aType = TType list ifTrue: [^ self readBool].! !
444
445!TProtocol methodsFor: 'reading' stamp: 'pc 10/24/2007 19:40'!
446readString! !
447
448!TProtocol methodsFor: 'reading' stamp: 'pc 10/24/2007 19:40'!
449readStructBegin
450	! !
451
452!TProtocol methodsFor: 'reading' stamp: 'pc 10/24/2007 19:40'!
453readStructEnd! !
454
455!TProtocol methodsFor: 'reading' stamp: 'pc 10/26/2007 21:34'!
456skip: aType
457	aType = TType stop ifTrue: [^ self].
458	aType = TType bool ifTrue: [^ self readBool].
459	aType = TType byte ifTrue: [^ self readByte].
460	aType = TType i16 ifTrue: [^ self readI16].
461	aType = TType i32 ifTrue: [^ self readI32].
462	aType = TType i64 ifTrue: [^ self readI64].
463	aType = TType string ifTrue: [^ self readString].
464	aType = TType double ifTrue: [^ self readDouble].
465	aType = TType struct ifTrue:
466		[| field |
467		self readStructBegin.
468		[(field := self readFieldBegin) type = TType stop] whileFalse:
469			[self skip: field type. self readFieldEnd].
470		^ self readStructEnd].
471	aType = TType map ifTrue:
472		[| map |
473		map := self readMapBegin.
474		map size timesRepeat: [self skip: map keyType. self skip: map valueType].
475		^ self readMapEnd].
476	aType = TType list ifTrue:
477		[| list |
478		list := self readListBegin.
479		list size timesRepeat: [self skip: list elemType].
480		^ self readListEnd].
481	aType = TType set ifTrue:
482		[| set |
483		set := self readSetBegin.
484		set size timesRepeat: [self skip: set elemType].
485		^ self readSetEnd].
486
487	self error: 'Unknown type'! !
488
489!TProtocol methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 23:02'!
490transport
491	^ transport! !
492
493!TProtocol methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 17:28'!
494transport: aTransport
495	transport := aTransport! !
496
497!TProtocol methodsFor: 'writing' stamp: 'pc 10/24/2007 19:37'!
498writeBool: aBool! !
499
500!TProtocol methodsFor: 'writing' stamp: 'pc 10/24/2007 19:37'!
501writeByte: aByte! !
502
503!TProtocol methodsFor: 'writing' stamp: 'pc 10/24/2007 19:38'!
504writeDouble: aFloat! !
505
506!TProtocol methodsFor: 'writing' stamp: 'pc 10/24/2007 19:38'!
507writeFieldBegin: aField! !
508
509!TProtocol methodsFor: 'writing' stamp: 'pc 10/24/2007 19:37'!
510writeFieldEnd! !
511
512!TProtocol methodsFor: 'writing' stamp: 'pc 10/24/2007 19:37'!
513writeFieldStop! !
514
515!TProtocol methodsFor: 'writing' stamp: 'pc 10/24/2007 19:37'!
516writeI16: i16! !
517
518!TProtocol methodsFor: 'writing' stamp: 'pc 10/24/2007 19:37'!
519writeI32: i32! !
520
521!TProtocol methodsFor: 'writing' stamp: 'pc 10/24/2007 19:37'!
522writeI64: i64! !
523
524!TProtocol methodsFor: 'writing' stamp: 'pc 10/24/2007 19:39'!
525writeListBegin: aList! !
526
527!TProtocol methodsFor: 'writing' stamp: 'pc 10/24/2007 19:37'!
528writeListEnd! !
529
530!TProtocol methodsFor: 'writing' stamp: 'pc 10/24/2007 19:39'!
531writeMapBegin: aMap! !
532
533!TProtocol methodsFor: 'writing' stamp: 'pc 10/24/2007 19:37'!
534writeMapEnd! !
535
536!TProtocol methodsFor: 'writing' stamp: 'pc 10/24/2007 19:36'!
537writeMessageBegin! !
538
539!TProtocol methodsFor: 'writing' stamp: 'pc 10/24/2007 19:36'!
540writeMessageEnd! !
541
542!TProtocol methodsFor: 'writing' stamp: 'pc 10/24/2007 19:39'!
543writeSetBegin: aSet! !
544
545!TProtocol methodsFor: 'writing' stamp: 'pc 10/24/2007 19:37'!
546writeSetEnd! !
547
548!TProtocol methodsFor: 'writing' stamp: 'pc 10/24/2007 19:38'!
549writeString: aString! !
550
551!TProtocol methodsFor: 'writing' stamp: 'pc 10/24/2007 19:38'!
552writeStructBegin: aStruct! !
553
554!TProtocol methodsFor: 'writing' stamp: 'pc 10/24/2007 19:37'!
555writeStructEnd! !
556
557Object subclass: #TResult
558	instanceVariableNames: 'success oprot iprot exception'
559	classVariableNames: ''
560	poolDictionaries: ''
561	category: 'Thrift'!
562
563!TResult methodsFor: 'as yet unclassified' stamp: 'pc 10/26/2007 21:35'!
564exception
565	^ exception! !
566
567!TResult methodsFor: 'as yet unclassified' stamp: 'pc 10/26/2007 21:35'!
568exception: anError
569	exception := anError! !
570
571!TResult methodsFor: 'as yet unclassified' stamp: 'pc 10/26/2007 14:43'!
572success
573	^ success! !
574
575!TResult methodsFor: 'as yet unclassified' stamp: 'pc 10/26/2007 14:43'!
576success: anObject
577	success := anObject! !
578
579Object subclass: #TSizedObject
580	instanceVariableNames: 'size'
581	classVariableNames: ''
582	poolDictionaries: ''
583	category: 'Thrift-Protocol'!
584
585TSizedObject subclass: #TList
586	instanceVariableNames: 'elemType'
587	classVariableNames: ''
588	poolDictionaries: ''
589	category: 'Thrift-Protocol'!
590
591!TList methodsFor: 'accessing' stamp: 'pc 10/24/2007 20:04'!
592elemType
593	^ elemType ifNil: [TType stop]! !
594
595!TList methodsFor: 'accessing' stamp: 'pc 10/24/2007 19:42'!
596elemType: anInteger
597	elemType := anInteger! !
598
599TList subclass: #TSet
600	instanceVariableNames: ''
601	classVariableNames: ''
602	poolDictionaries: ''
603	category: 'Thrift-Protocol'!
604
605TSizedObject subclass: #TMap
606	instanceVariableNames: 'keyType valueType'
607	classVariableNames: ''
608	poolDictionaries: ''
609	category: 'Thrift-Protocol'!
610
611!TMap methodsFor: 'accessing' stamp: 'pc 10/24/2007 20:04'!
612keyType
613	^ keyType ifNil: [TType stop]! !
614
615!TMap methodsFor: 'accessing' stamp: 'pc 10/24/2007 19:45'!
616keyType: anInteger
617	keyType := anInteger! !
618
619!TMap methodsFor: 'accessing' stamp: 'pc 10/24/2007 20:04'!
620valueType
621	^ valueType ifNil: [TType stop]! !
622
623!TMap methodsFor: 'accessing' stamp: 'pc 10/24/2007 19:45'!
624valueType: anInteger
625	valueType := anInteger! !
626
627!TSizedObject methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 20:03'!
628size
629	^ size ifNil: [0]! !
630
631!TSizedObject methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 20:06'!
632size: anInteger
633	size := anInteger! !
634
635Object subclass: #TSocket
636	instanceVariableNames: 'host port stream'
637	classVariableNames: ''
638	poolDictionaries: ''
639	category: 'Thrift-Transport'!
640
641!TSocket methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 22:34'!
642close
643	self isOpen ifTrue: [stream close]! !
644
645!TSocket methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 22:23'!
646connect
647	^ (self socketStream openConnectionToHost:
648		(NetNameResolver addressForName: host) port: port)
649			timeout: 180;
650			binary;
651			yourself! !
652
653!TSocket methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 20:35'!
654flush
655	stream flush! !
656
657!TSocket methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 17:08'!
658host: aString
659	host := aString! !
660
661!TSocket methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 20:34'!
662isOpen
663	^ stream isNil not
664		and: [stream socket isConnected]
665		and: [stream socket isOtherEndClosed not]! !
666
667!TSocket methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 22:22'!
668open
669	stream := self connect! !
670
671!TSocket methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 17:09'!
672port: anInteger
673	port := anInteger! !
674
675!TSocket methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 17:17'!
676read: size
677	| data |
678	[data := stream next: size.
679	data isEmpty ifTrue: [TTransportError signal: 'Could not read ', size asString, ' bytes'].
680	^ data]
681		on: ConnectionClosed
682		do: [TTransportClosedError signal]! !
683
684!TSocket methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 22:18'!
685socketStream
686	^ Smalltalk at: #FastSocketStream ifAbsent: [SocketStream] ! !
687
688!TSocket methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 22:17'!
689write: aCollection
690	[stream nextPutAll: aCollection]
691		on: ConnectionClosed
692		do: [TTransportClosedError signal]! !
693
694Object subclass: #TStruct
695	instanceVariableNames: 'name'
696	classVariableNames: ''
697	poolDictionaries: ''
698	category: 'Thrift-Protocol'!
699
700!TStruct methodsFor: 'accessing' stamp: 'pc 10/24/2007 19:47'!
701name
702	^ name! !
703
704!TStruct methodsFor: 'accessing' stamp: 'pc 10/24/2007 19:47'!
705name: aString
706	name := aString! !
707
708Object subclass: #TTransport
709	instanceVariableNames: ''
710	classVariableNames: ''
711	poolDictionaries: ''
712	category: 'Thrift-Transport'!
713
714!TTransport methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 17:18'!
715close
716	self subclassResponsibility! !
717
718!TTransport methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 17:22'!
719flush
720	self subclassResponsibility! !
721
722!TTransport methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 17:18'!
723isOpen
724	self subclassResponsibility! !
725
726!TTransport methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 17:18'!
727open
728	self subclassResponsibility! !
729
730!TTransport methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 17:18'!
731read: anInteger
732	self subclassResponsibility! !
733
734!TTransport methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 17:22'!
735readAll: anInteger
736	^ String streamContents: [:str |
737		[str size < anInteger] whileTrue:
738			[str nextPutAll: (self read: anInteger - str size)]]! !
739
740!TTransport methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 17:22'!
741write: aString
742	self subclassResponsibility! !
743
744Object subclass: #TType
745	instanceVariableNames: ''
746	classVariableNames: ''
747	poolDictionaries: ''
748	category: 'Thrift'!
749
750!TType class methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 17:03'!
751bool
752	^ 2! !
753
754!TType class methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 17:03'!
755byte
756	^ 3! !
757
758!TType class methodsFor: 'as yet unclassified' stamp: 'pc 10/25/2007 15:55'!
759codeOf: aTypeName
760	self typeMap do: [:each | each first = aTypeName ifTrue: [^ each second]].
761	^ nil! !
762
763!TType class methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 17:03'!
764double
765	^ 4! !
766
767!TType class methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 17:04'!
768i16
769	^ 6! !
770
771!TType class methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 17:04'!
772i32
773	^ 8! !
774
775!TType class methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 17:04'!
776i64
777	^ 10! !
778
779!TType class methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 17:04'!
780list
781	^ 15! !
782
783!TType class methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 17:04'!
784map
785	^ 13! !
786
787!TType class methodsFor: 'as yet unclassified' stamp: 'pc 10/25/2007 15:56'!
788nameOf: aTypeCode
789	self typeMap do: [:each | each second = aTypeCode ifTrue: [^ each first]].
790	^ nil! !
791
792!TType class methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 17:04'!
793set
794	^ 14! !
795
796!TType class methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 17:03'!
797stop
798	^ 0! !
799
800!TType class methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 17:04'!
801string
802	^ 11! !
803
804!TType class methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 17:04'!
805struct
806	^ 12! !
807
808!TType class methodsFor: 'as yet unclassified' stamp: 'pc 10/25/2007 15:51'!
809typeMap
810	^ #((bool 2) (byte 3) (double 4) (i16 6) (i32 8) (i64 10) (list 15)
811	   (map 13) (set 15) (stop 0) (string 11) (struct 12) (void 1))! !
812
813!TType class methodsFor: 'as yet unclassified' stamp: 'pc 10/24/2007 17:03'!
814void
815	^ 1! !
816