"{ Package: 'stx:goodies/xtreams/transforms' }"

"{ NameSpace: Xtreams }"

Object subclass:#MessagePackMarshaler

	instanceVariableNames:'unmarshaling marshaling analysing'

	classVariableNames:''

	category:'Xtreams-Transforms'

!

MessagePackMarshaler comment:'MessagePackMarshaler defines the binary format of the MessagePack protocol ( http://wiki.msgpack.org/display/MSGPACK/Format+specification ), which is a binary JSON. It can marshal simple objects, but not whole classes, just like JSON. It is considered to be a very fast marshaler because of its lightweight protocol. It cannot handle circular references.

Instance Variables

	analysing	<Object>	analysing operations

	marshaling	<Dictionary>	marshaling operations

	unmarshaling	<(Array of: (BlockClosure))>	unmarshaling operations

'

!

!MessagePackMarshaler class methodsFor:'instance creation'!

new

	^super new initialize

! !

!MessagePackMarshaler class methodsFor:'constants - containers'!

array16

	^16rDC

!

array32

	^16rDD

!

map16

	^16rDE

!

map32

	^16rDF

!

raw16

	^16rDA

!

raw32

	^16rDB

! !

!MessagePackMarshaler class methodsFor:'constants - numbers'!

double

	^16rCB

!

float

	^16rCA

!

int16

	^16rD1

!

int32

	^16rD2

!

int64

	^16rD3

!

int8

	^16rD0

!

uint16

	^16rCD

!

uint32

	^16rCE

!

uint64

	^16rCF

!

uint8

	^16rCC

! !

!MessagePackMarshaler class methodsFor:'constants - singletons'!

false

	^16rC2

!

nil

	^16rC0

!

true

	^16rC3

! !

!MessagePackMarshaler methodsFor:'api'!

analyse: reading

	| type |

	type := reading uint8 get.

	type <= 16rBF ifTrue: [

		| fixMapOrArray |

		type <= 16r7F ifTrue: [^reading log: 'positive fixnum' do: [type]].

		fixMapOrArray := type bitShift: -4.

		fixMapOrArray = 2r1001 ifTrue: [^reading log: 'fix array' do: [(1 to: (type bitAnd: 2r00001111)) collect: [:i | self analyse: reading]]].

		fixMapOrArray = 2r1000 ifTrue: [

			^reading log: 'fix map' do: [

				| map |

				map := Dictionary new.

				(type bitAnd: 2r00001111) timesRepeat: [

					map at: (self analyse: reading) put: (self analyse: reading)].

				map]].

		^reading log: 'fix raw' do: [reading uint8 read: (type bitAnd: 2r00011111)]].

	(type bitShift: -5) = 2r111 ifTrue: [^reading log: 'negative fixnum' do: [-32 + (type bitAnd: 2r00011111)]].

	^reading log: (type printStringRadix: 16) do: [(analysing at: type) value: reading]

!

marshal: writing object: object

	(marshaling at: object class ifAbsent: [self error: 'Unmarshalable class with the MessagePack protocol']) value: writing value: object

!

unmarshal: reading

	| type |

	type := reading uint8 get.

	type <= 16rBF ifTrue: [

		| fixMapOrArray |

		type <= 16r7F ifTrue: [^type].

		fixMapOrArray := type bitShift: -4.

		fixMapOrArray = 2r1001 ifTrue: [^(1 to: (type bitAnd: 2r00001111)) collect: [:i | self unmarshal: reading]].

		fixMapOrArray = 2r1000 ifTrue: [

			| map |

			map := Dictionary new.

			(type bitAnd: 2r00001111) timesRepeat: [

				map at: (self unmarshal: reading) put: (self unmarshal: reading)].

			^map].

		^reading uint8 read: (type bitAnd: 2r00011111)].

	(type bitShift: -5) = 2r111 ifTrue: [^-32 + (type bitAnd: 2r00011111)].

	^(unmarshaling at: type) value: reading

! !

!MessagePackMarshaler methodsFor:'configuration'!

configureAnalyse: reading

	"This protocol has fixed endianness built in"

	^true

!

configureMarshal: writing

	"This protocol has fixed endianness built in"

	^true

!

configureUnmarshal: reading

	"This protocol has fixed endianness built in"

	^true

! !

!MessagePackMarshaler methodsFor:'initialize-release'!

initialize

	self initializeMarshaling.

	self initializeUnmarshaling.

	self initializeAnalysing.

!

initializeAnalysing

	(analysing := unmarshaling copy)

		at: self class array16 put: [:reading | reading log: 'array16' do: [(1 to: reading uint16 get) collect: [:i | self analyse: reading]]];

		at: self class array32 put: [:reading | reading log: 'array32' do: [(1 to: reading uint32 get) collect: [:i | self analyse: reading]]];

		at: self class map16 put: [:reading |

			reading log: 'map16' do: [

				| map |

				map := Dictionary new.

				reading uint16 get timesRepeat: [

					map at: (self analyse: reading) put: (self analyse:reading)].

				map]];

		at: self class map32 put: [:reading |

			reading log: 'map32' do: [

				| map |

				map := Dictionary new.

				reading uint16 get timesRepeat: [

					map at: (self analyse: reading) put: (self analyse: reading)].

				map]];

		yourself

!

initializeMarshaling

	(marshaling := Dictionary new)

		"singletons"

		at: UndefinedObject put: [:writing :object | writing uint8 put: self class nil];

		at: True put: [:writing :object | writing uint8 put: self class true];

		at: False put: [:writing :object | writing uint8 put: self class false];

		"numbers"

		at: Float put: [:writing :object | writing uint8 put: self class float. writing float put: object];

		at: Double put: [:writing :object | writing uint8 put: self class double. writing double put: object];

		at: SmallDouble put: [:writing :object | writing uint8 put: self class double. writing double put: object];

		yourself.

	Integer allSubclassesDo: [:each |

		marshaling at: each put: [:writing :object | self write: writing integer: object]].

	SequenceableCollection allSubclassesDo: [:each |

		marshaling at: each put: [:writing :object | self write: writing array: object]].

	(KeyedCollection withAllSubclasses, Dictionary withAllSubclasses) do: [:each |

		marshaling at: each put: [:writing :object | self write: writing map: object]].

	(CharacterArray withAllSubclasses, IntegerArray withAllSubclasses) do: [:each |

		marshaling at: each put: [:writing :object | self error: each name, ' are not supported by the MessagePack protocol']].

	marshaling at: ByteArray put: [:writing :object | self write: writing raw: object]

!

initializeUnmarshaling

	(unmarshaling := Array new: 255 withAll: [:reading | self error: 'unknown type'])

		"singletons"

		at: self class nil put: [:reading | nil];

		at: self class true put: [:reading | true];

		at: self class false put: [:reading | false];

		"numbers"

		at: self class uint8 put: [:reading | reading uint8 get];

		at: self class uint16 put: [:reading | reading uint16 get];

		at: self class uint32 put: [:reading | reading uint32 get];

		at: self class uint64 put: [:reading | reading uint64 get];

		at: self class int8 put: [:reading | reading int8 get];

		at: self class int16 put: [:reading | reading int16 get];

		at: self class int32 put: [:reading | reading int32 get];

		at: self class int64 put: [:reading | reading int64 get];

		at: self class float put: [:reading | reading float get];

		at: self class double put: [:reading | reading double get];

		"containers"

		at: self class raw16 put: [:reading | reading uint8 read: reading uint16 get];

		at: self class raw32 put: [:reading | reading uint8 read: reading uint32 get];

		at: self class array16 put: [:reading | (1 to: reading uint16 get) collect: [:i | self unmarshal: reading]];

		at: self class array32 put: [:reading | (1 to: reading uint32 get) collect: [:i | self unmarshal: reading]];

		at: self class map16 put: [:reading |

			| map |

			map := Dictionary new.

			reading uint16 get timesRepeat: [

				map at: (self unmarshal: reading) put: (self unmarshal: reading)].

			map];

		at: self class map32 put: [:reading |

			| map |

			map := Dictionary new.

			reading uint32 get timesRepeat: [

				map at: (self unmarshal: reading) put: (self unmarshal: reading)].

			map];

		yourself

! !

!MessagePackMarshaler methodsFor:'private - writing'!

write: writing array: array

	self write: writing array_size: array size.

	array do: [:each | self marshal: writing object: each]

!

write: writing array_size: size

	size <= 2r00001111 ifTrue: [^writing uint8 put: size + 2r10010000].

	size <= 65535 ifTrue: [

		writing uint8 put: self class array16.

		^writing uint16 put: size].

	size <= 4294967295 ifTrue: [

		writing uint8 put: self class array32.

		^writing uint32 put: size].

	self error: 'array too big to marshal with MessagePack protocol'

!

write: writing integer: integer

	(integer between: 0 and: 127) ifTrue: [^writing uint8 put: integer].

	(integer between: -32 and: -1) ifTrue: [^writing uint8 put: integer + 256].

	integer >= 128 ifTrue: [

		integer <= 255 ifTrue: [^writing uint8 put: self class uint8; put: integer].

		integer <= 65535 ifTrue: [

			writing uint8 put: self class uint16.

			^writing uint16 put: integer].

		integer <= 4294967295 ifTrue: [

			writing uint8 put: self class uint32.

			^writing uint32 put: integer].

		integer <= 18446744073709551615 ifTrue: [

			writing uint8 put: self class uint64.

			^writing uint64 put: integer].

		self error: 'integer too big to marshal with MessagePack protocol'].

	integer >= -128 ifTrue: [

		writing uint8 put: self class int8.

		^writing int8 put: integer].

	integer >= -32768 ifTrue: [

		writing uint8 put: self class int16.

		^writing int16 put: integer].

	integer >= -2147483648 ifTrue: [

		writing uint8 put: self class int32.

		^writing int32 put: integer].

	integer >= -9223372036854775808 ifTrue: [

		writing uint8 put: self class int64.

		^writing int64 put: integer].

	self error: 'integer too small to marshal with MessagePack protocol'.

!

write: writing map: map

	self write: writing map_size: map size.

	map keysAndValuesDo: [:key :value |

		self marshal: writing object: key.

		self marshal: writing object: value]

!

write: writing map_size: size

	size <= 2r00001111 ifTrue: [^writing uint8 put: size + 2r10000000].

	size <= 65535 ifTrue: [

		writing uint8 put: self class map16.

		^writing uint16 put: size].

	size <= 4294967295 ifTrue: [

		writing uint8 put: self class map32.

		^writing uint32 put: size].

	self error: 'array too big to marshal with MessagePack protocol'

!

write: writing raw: bytearray

	self write: writing raw_size: bytearray size.

	writing uint8 write: bytearray

!

write: writing raw_size: size

	size <= 2r00011111 ifTrue: [^writing uint8 put: size + 2r10100000].

	size <= 65535 ifTrue: [

		writing uint8 put: self class raw16.

		^writing uint16 put: size].

	size <= 4294967295 ifTrue: [

		writing uint8 put: self class raw32.

		^writing uint32 put: size].

	self error: 'array too big to marshal with MessagePack protocol'

! !

!MessagePackMarshaler class methodsFor:'documentation'!

version_SVN

    ^ '$Id$'

! !