'From etoys3.0 of 7 March 2008 [latest update: #2020] on 19 June 2008 at 9:51:11 pm'!
"Change Set:		DBus-Core-bf-42
Date:			19 June 2008
Author:			Bert Freudenberg

Name: DBus-Core-bf.42
Author: bf
Time: 19 June 2008, 9:24:59 pm
UUID: 002bd5dd-dd64-4f32-9bdc-5d79335c9788
Ancestors: DBus-Core-bf.41

- fix sending ByteArrays
- coerce numbers to Float or Integer when sending
- rename selector to member to match DBus terminology
- message type is now a string, typeCode an int"!


!DBusConnection commentStamp: '<historical>' prior: 0!
I represent a connection to the DBus (see http://dbus.freedesktop.org/).

connectionIndex: 0 for session bus, 1 for system bus
semaIndex: index of the read semaphore in the externalObjects array

This class is known to the DBus plugin. The connectionIndex and semaIndex must be the first instance variables in the class.

The plugin automatically connects to the DBus when a primitive of me is called.!

Object subclass: #DBusMessage
	instanceVariableNames: 'type path interface selector sender destination arguments serial member typeCode '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'DBus-Core'!

!DBusMessage commentStamp: 'jaf 5/26/2007 20:32' prior: 0!
I am the super class for messages which can send exchanged over a DBusConnection. For an example look at DBusMessage testMethodCall.

This class is known to the DBus plugin. You must not change the order of instance variables.
!


!Object methodsFor: '*DBus-Core' stamp: 'bf 6/17/2008 16:04'!
asDBusArgumentSignature: aSignature
	^ DBusArgument value: self signature: aSignature! !

!Object methodsFor: '*DBus-Core' stamp: 'bf 6/18/2008 16:37'!
dbusCoerceTo: type
	^ self! !


!DBusArgument methodsFor: 'printing' stamp: 'bf 6/19/2008 20:16'!
printContainedSignatureOn: aStream
	"XXX refactor into subclasses"

	type = DBusArgument variant
		ifTrue: [
			"stored signature would be 'v' so ignore, must use actual signature"
			^value asDBusArgument printSignatureOn: aStream].

	signature ifNotNil: [
		^('{(' includes: signature first)
			ifTrue: [aStream next: signature size - 2 putAll: signature startingAt: 2]
			ifFalse: [aStream next: signature size - 1 putAll: signature startingAt: 2]].

	type caseOf: {
		[DBusArgument struct]
			-> [value do: [:ea| ea asDBusArgument printSignatureOn: aStream]].
		[DBusArgument dictEntry]
			-> [value key asDBusArgument printSignatureOn: aStream.
				value value asDBusArgument printSignatureOn: aStream].
		[DBusArgument array]
			-> [value class == ByteArray
				ifTrue: [aStream nextPut: DBusArgument byte]
				ifFalse: [value first asDBusArgument printSignatureOn: aStream]].
	}					   

			! !

!DBusArgument methodsFor: 'initialize' stamp: 'bf 6/18/2008 16:44'!
value: anObject type: aChar
	type := aChar.
	value := anObject dbusCoerceTo: type! !


!DBusArgument class methodsFor: 'instance creation' stamp: 'bf 6/18/2008 16:45'!
value: value signature: s
	| arg |
	arg := self value: value type: (
		s first caseOf: {
			[${] -> [self dictEntry].
			[$(] -> [self struct].
		} otherwise: [s first]).
	arg signature: s.
	^arg	
	

! !

!DBusArgument class methodsFor: 'instance creation' stamp: 'bf 6/18/2008 16:47'!
value: value type: t
	^ self new value: value type: t
	! !


!DBusConnection methodsFor: 'accessing' stamp: 'bf 6/19/2008 01:23'!
messageMember
	^ self primMessageGetMember! !

!DBusConnection methodsFor: 'arguments-write' stamp: 'bf 6/19/2008 20:33'!
argumentWriteArray: arg
	| sig |
	sig := arg containedSignature.
	(self openContainerOfType: arg dbusType containedSignature: sig) ifTrue: [
		sig = 'y'
			ifTrue: [arg value do: [:each | self primAppendBasicArgument: each ofType: 121]]
			ifFalse: [arg containedDBusArgumentsDo: [:each| self writeArgument: each]].
		self primCloseContainer ]. 
! !

!DBusConnection methodsFor: 'messages' stamp: 'bf 6/19/2008 01:55'!
popMessage
	""

	"first read dbus connection"
	
	| type msg |
	type := self primPopMessage.
	
	"if there is no new message reveived return"
	(type = 0) ifTrue:[^nil]. 
	
	"create new message"
	msg := DBusMessage typeCode: type.
	msg ifNil:[^nil].
	
	"read message from the bus"
	msg readFromConnection: self.

	^msg! !


!DBusConnection class methodsFor: 'examples' stamp: 'bf 6/19/2008 01:09'!
example
	"this example show the general low level usage of the dbus plugin"
	" to start call
		DBusConnection example
	  
	to stop the process call
		DBusConnection new sendMessage: (DBusMessage testMethodCall member: 'setprocessstatus')
	
	send a signal	
		DBusConnection new sendMessage: (DBusMessage testSignal)
	"
	
	| connection msg process appName |
	
	appName := 'org.squeak.dbus.example'.
	
	"connect tot session bus"
	connection := DBusConnection sessionBus.

	"request unique name for squeak example at dbus"
	connection registerName: appName.	
		
	"register a match rule to receive a certain signal"
	connection addMatch: #(
		type 'signal'
		interface 'org.squeak.dbus.testinterface').
	
	process := true.
	
	[
		Transcript show: String cr, '--- Begin dbus queue processing ---'; cr.
		 
		"step the connection"	
		[process] whileTrue: [
			[connection dataRemains] whileTrue: [
				"read messages"
				msg := connection popMessage.
				msg ifNotNil: [Transcript show: 'Received message: ', msg asString; cr.
							 "process message"
							  msg isMethodCall 
								ifTrue: [ ((msg member = 'setprocessstatus') and: [msg hasArguments]) 
											ifTrue: [ process := (msg arguments at: 1) value ]
											ifFalse: [ "answer an error"
													connection sendMessage: (DBusMessageError unknownMethod: msg)] ]
							].
				].
			process ifTrue: [connection readSemaphore wait].
		].
		
		"release name"
		connection releaseName: appName.
		
		"close connection"
		connection close.

		Transcript show: '--- end ---' , String cr.  
	] forkAt: Processor userBackgroundPriority.

	" send a quit message
	
	DBusConnection new sendMessage: 
		((DBusMessageMethodCall destination: 'org.squeak.dbus.example' 
								path: '/org/squeak/dbus/example' 
								interface: 'org.squeak.dbus.test' 
								member: 'setprocessstatus' )
								addArgument: (DBusArgument bool: false);	
								reply: false)
	"
! !


!DBusMessage methodsFor: 'accessing' stamp: 'bf 6/12/2008 16:22'!
arguments

	^arguments asArray! !

!DBusMessage methodsFor: 'accessing' stamp: 'bf 6/19/2008 01:22'!
fullSelector
	^interface
		ifNil: [member]
		ifNotNil: [interface, '.', member]! !

!DBusMessage methodsFor: 'accessing' stamp: 'bf 6/19/2008 01:22'!
member
	^member! !

!DBusMessage methodsFor: 'accessing' stamp: 'bf 6/19/2008 01:22'!
member: memberString
	member := memberString! !

!DBusMessage methodsFor: 'accessing' stamp: 'bf 6/19/2008 12:03'!
path
	^path! !

!DBusMessage methodsFor: 'accessing' stamp: 'bf 6/19/2008 12:04'!
path: pathString
	path := pathString
! !

!DBusMessage methodsFor: 'accessing' stamp: 'bf 6/19/2008 01:54'!
type
	^self class typeStrings at: typeCode ifAbsent: [nil]! !

!DBusMessage methodsFor: 'initialize-release' stamp: 'bf 6/19/2008 01:54'!
initialize

	path := ''.
	interface := nil.
	sender := ''.
	member := ''.
	destination := ''.
	arguments := OrderedCollection new.
	typeCode := self class typeCode.
	serial := 0.
	
	! !

!DBusMessage methodsFor: 'printing' stamp: 'bf 6/19/2008 12:04'!
printOn: aStream	

	aStream nextPutAll: self class name.
	(self serial > 0) 
		ifTrue: [
			aStream nextPut: $(.
			self serial printOn: aStream.
			aStream nextPut: $).			
		].
	aStream nextPut: $[;
		nextPutAll: (self path ifNil: ['?']);
		space;
		nextPutAll: (self fullSelector ifNil: ['?']).
	self printArgumentsOn: aStream.	
	aStream nextPut: $]
	! !

!DBusMessage methodsFor: 'read writing' stamp: 'bf 6/19/2008 12:04'!
readFromConnection: conn
	self path: conn messagePath.
	self sender: conn messageSender.
	self interface: conn messageInterface.
	self member: conn messageMember.
	self serial: conn messageSerial.
	self readArgumentsFrom: conn
	
	
	
	
	
	! !


!DBusMessage class methodsFor: 'accessing' stamp: 'bf 6/19/2008 01:52'!
type
	^self typeStrings at: self typeCode ifAbsent: [nil]! !

!DBusMessage class methodsFor: 'accessing' stamp: 'bf 6/19/2008 01:53'!
typeCode
	^0! !

!DBusMessage class methodsFor: 'accessing' stamp: 'bf 6/19/2008 01:44'!
typeStrings
	^#('method_call' 'method_return'  'error' 'signal')! !

!DBusMessage class methodsFor: 'instance creation' stamp: 'bf 6/19/2008 01:56'!
typeCode: anInteger
	^(self subclasses detect: [:each | each typeCode = anInteger]) new
! !

!DBusMessage class methodsFor: 'examples' stamp: 'bf 6/19/2008 01:12'!
testMethodCall

	"create a new method call"
	| msg |
	msg := DBusMessageMethodCall destination: 'org.squeak.dbus.example' 
								path: '/org/squeak/dbus/example' 
								interface: 'org.squeak.dbus.testinterface' 
								member: 'testmember'.
	"add some arguments"							
	msg addArgument: (DBusArgument boolean: false). "boolean"	
	msg addArgument: (DBusArgument int32: 125487). "integer 32"
	msg addArgument: (DBusArgument array: {'element 0'. 'element 1'. 'element 2'} signature: 'as'). "3 element array of strings"
	msg addArgument: (DBusArgument variant: (DBusArgument uint64: 45879245651)). "variant with an unsigned integer 64"
		
	^msg		
								! !


!DBusMessageError methodsFor: 'accessing' stamp: 'bf 6/10/2008 18:31'!
message
	^arguments first fromDBusArgument! !


!DBusMessageError class methodsFor: 'accessing' stamp: 'bf 6/19/2008 01:53'!
typeCode
	^3! !


!DBusMessageMethodCall class methodsFor: 'instance creation' stamp: 'bf 6/19/2008 01:11'!
destination: d path: p interface: i member: t

	^ self destination: d path: p  interface: i  member: t reply: true ! !

!DBusMessageMethodCall class methodsFor: 'instance creation' stamp: 'bf 6/19/2008 12:05'!
destination: d path: p interface: i member: t reply: b

	| msg |
	msg := self new.
	msg destination: d ; path: p ; interface: i ; member: t; reply: b.
	^msg! !

!DBusMessageMethodCall class methodsFor: 'accessing' stamp: 'bf 6/19/2008 01:53'!
typeCode
	^1! !


!DBusMessageMethodReply class methodsFor: 'accessing' stamp: 'bf 6/19/2008 01:53'!
typeCode
	^2! !


!DBusMessageSignal class methodsFor: 'accessing' stamp: 'bf 6/19/2008 01:53'!
typeCode
	^4! !

!DBusMessageSignal class methodsFor: 'class initialization' stamp: 'bf 6/19/2008 12:05'!
path: p interface: i name: t

	| msg |
	msg := self new.
	msg path: p ; interface: i ; member: t.
	^msg! !


!Number methodsFor: '*DBus-Core' stamp: 'bf 6/18/2008 16:38'!
dbusCoerceTo: type
	^(type = DBusArgument double)
		ifTrue: [self asFloat]
		ifFalse: [self asInteger]! !

DBusMessageSignal class removeSelector: #messageType!
DBusMessageMethodReply class removeSelector: #messageType!
DBusMessageMethodCall class removeSelector: #destination:path:interface:selector:!
DBusMessageMethodCall class removeSelector: #destination:path:interface:selector:reply:!
DBusMessageMethodCall class removeSelector: #messageType!
DBusMessageError class removeSelector: #messageType!
DBusMessage class removeSelector: #messageType!
DBusMessage class removeSelector: #newErrorFor:name:message:!
DBusMessage class removeSelector: #newFromType:!
DBusMessage removeSelector: #objectPath!
DBusMessage removeSelector: #objectPath:!
DBusMessage removeSelector: #selector!
DBusMessage removeSelector: #selector:!
Object subclass: #DBusMessage
	instanceVariableNames: 'typeCode path interface member sender destination arguments serial'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'DBus-Core'!
DBusConnection removeSelector: #messageSelector!
DBusArgument removeSelector: #type:!
DBusArgument removeSelector: #value:!