'From etoys3.0 of 19 February 2008 [latest update: #1914] on 12 March 2008 at 4:14:22 pm'!
"Change Set:		sugarDBus-bf
Date:			12 March 2008
Author:			Bert Freudenberg

- adapt to new DBus-Core (needs new plugin)
- prevent endless loop in msg dispatching
- remove handlers on timeout"!


!SugarLauncher methodsFor: 'dbus' stamp: 'bf 3/3/2008 17:35'!
dispatchDBusMessage: msg

	| interface selector handler attempts |
	WorldState addDeferredUIMessage: [Transcript cr; show: msg].

	msg isReplyOrError ifTrue: [
		[attempts := 0.
		[handler := handlers removeKey: msg replySerial ifAbsent: [].
		handler notNil] whileFalse: [
			WorldState addDeferredUIMessage: [Transcript cr; show: 'dbus handler for ',  msg replySerial asString,' not registered yet'].
			attempts := attempts + 1.
			attempts > 10 ifTrue: [^false].
			(Delay forMilliseconds: attempts*10) wait].
		msg isError
			ifTrue: [handler second value: msg]
			ifFalse: [handler first value: msg]
		]
			forkAt: Processor activePriority - 1
			named: 'DBus reply ', msg replySerial asString.
		^true].

	interface := msg interface isEmpty
		ifTrue: [(self dbusMessageRegistry detect: [:ea | ea last anySatisfy: [:meth | meth first = msg selector]] ifNone: [^false]) last]
		ifFalse: [(self dbusMessageRegistry detect: [:ea | ea first = msg interface] ifNone: [^false]) last].
	selector := (interface detect: [:ea | ea first = msg selector] ifNone: [^false]) last.
	[self perform: selector with: msg]
		forkAt:  Processor activePriority - 1
		named: 'DBus handler ', msg serial asString.
	^true! !

!SugarLauncher methodsFor: 'dbus' stamp: 'bf 3/5/2008 17:33'!
runDBusService: aString
	| msg  error serviceName |
	serviceName := aString.
	dbus := DBusConnection sessionBus.
	dbus registerName: serviceName.
	handlers := Dictionary new.
	[[
		[dbus dataRemains] whileTrue: [
			(msg := dbus popMessage) ifNotNil: [
				((self dispatchDBusMessage: msg) not and: [msg isMethodCall]) ifTrue: [
					error := DBusMessageError newFor: msg
							name: (DBusMessageError dbusErrorUnknownMethod)
							withMessage: self bundleId, ' does not understand ', msg selector, '()'.
					error ifNotNil: [dbus sendMessage: error]].
		]].
		dbus readSemaphore wait.
	] repeat]  ensure: 
		[[dbus releaseName: serviceName] ifError: []]
! !

!SugarLauncher methodsFor: 'dbus' stamp: 'bf 3/3/2008 14:31'!
sendDBusMessage: aMessage onSuccess: successBlock onError: errorBlock
	"send aMessage asynchronously, evaluate successBlock or errorBlock with the reply message once a response comes back. Does not handle timeout!!"
	| replyCode |
	replyCode := dbus sendMessage: aMessage.
	handlers at: replyCode put: {successBlock. errorBlock}.
	WorldState addDeferredUIMessage: [Transcript cr; show: aMessage].
	^replyCode! !

!SugarLauncher methodsFor: 'dbus' stamp: 'bf 3/3/2008 14:35'!
sendDBusMessage: aMessage timeout: seconds
	"send aMessage synchronously, wait until a response comes back or timeout seconds have passed. Answer reply message, or raise an error if send failed or timed out"
	| milli sema reply replyCode |
	sema := Semaphore new.
 	milli := (seconds * 1000) asInteger.
	milli > 0 ifTrue: [Delay timeoutSemaphore: sema afterMSecs: milli].
	replyCode := self sendDBusMessage: aMessage
		onSuccess: [:msg | reply := msg. sema signal]
		onError: [:err | reply := err. sema signal].
	sema wait.
	reply ifNil: [
		handlers  removeKey: replyCode ifAbsent: [].
		^self error: 'dbus send timed out' translated].
	reply isError ifTrue: [^self error: reply arguments first fromDBusArgument].
	^reply! !


!SugarLauncher class methodsFor: 'accessing' stamp: 'bf 2/22/2008 16:52'!
current
	^Current ifNil: [Current := self new]! !