Object subclass: #XMLRPCDateTime
	instanceVariableNames: 'date time'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Synerge-XML-RPC'!

!XMLRPCDateTime methodsFor: 'as yet unclassified' stamp: 'chl 10/10/2001 00:12'!
date
	^ date! !

!XMLRPCDateTime methodsFor: 'as yet unclassified' stamp: 'chl 10/10/2001 00:13'!
date: aDate
	date _ aDate! !

!XMLRPCDateTime methodsFor: 'as yet unclassified' stamp: 'chl 10/10/2001 00:12'!
time
	^ time! !

!XMLRPCDateTime methodsFor: 'as yet unclassified' stamp: 'chl 10/10/2001 00:12'!
time: aTime
	time _ aTime! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

XMLRPCDateTime class
	instanceVariableNames: ''!

!XMLRPCDateTime class methodsFor: 'as yet unclassified' stamp: 'chl 10/10/2001 00:14'!
fromDate: aDate time: aTime
	^ self new date: aDate; time: aTime! !


Object subclass: #XMLRPCDecoder
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Synerge-XML-RPC'!

!XMLRPCDecoder methodsFor: 'as yet unclassified' stamp: 'jam 4/19/2007 15:22'!
decode: anXMLElement
	(anXMLElement elementAt: 'value') elements isEmpty ifTrue: [^ (anXMLElement elementAt: 'value') contentString].

	(((anXMLElement elementAt: 'value') elements at: 1) key = 'string') ifTrue: [
				^ ((anXMLElement entityAt: 'value') entityAt: 'string') contentString	].
				
				(((anXMLElement element: 'value') elements at: 1) key = 'i4') ifTrue: [
							^ SmallInteger readFrom: (((anXMLElement entityAt: 'value') entityAt: 'i4') contentString readStream)
									].
								
				(((anXMLElement elementAt: 'value') elements at: 1) key = 'int') ifTrue: [
							^ SmallInteger readFrom: (((anXMLElement entityAt: 'value') entityAt: 'int') contentString readStream)
									].
								
				(((anXMLElement elementAt: 'value') elements at: 1) key = 'double') ifTrue: [
							^ Float readFrom: (((anXMLElement entityAt: 'value') entityAt: 'double') contentString readStream)
									].
								
				(((anXMLElement elementAt: 'value') elements at: 1) key = 'base64') ifTrue: [
							^ Base64MimeConverter mimeDecodeToBytes: ((anXMLElement entityAt: 'value') entityAt: 'base64') contentString readStream
									].
								
				(((anXMLElement elementAt: 'value') elements at: 1) key = 'dateTime.iso8601') ifTrue: [
							^ self decodeDateTime: ((anXMLElement entityAt: 'value') entityAt: 'dateTime.iso8601') contentString
									].
				
				(((anXMLElement elementAt: 'value') elements at: 1) key = 'boolean') ifTrue: [
				      (((anXMLElement entityAt: 'value') entityAt: 'boolean') contentString = '1') ifTrue: [^ True] ifFalse: [^ False]
						].
				(((anXMLElement elementAt: 'value') elements at: 1) key = 'array') ifTrue: [^ self decodeArray: anXMLElement].
				(((anXMLElement elementAt: 'value') elements at: 1) key = 'struct') ifTrue: [^ self decodeStruct: anXMLElement].! !

!XMLRPCDecoder methodsFor: 'as yet unclassified' stamp: 'chl 10/9/2001 01:25'!
decodeArray: anXMLElement
	| coll |
	coll _ OrderedCollection new.
	(((anXMLElement entityAt: 'value') entityAt: 'array') entityAt: 'data') entities do: [ :xmlElem | 
		coll add: (self decode: (XMLDocument new addEntity: (xmlElem value)))
		].
	^ coll asArray! !

!XMLRPCDecoder methodsFor: 'as yet unclassified' stamp: 'chl 10/12/2001 01:00'!
decodeDateTime: aDT
	| d t |
	d _ Date 
		newDay: (aDT copyFrom: 7 to: 8) asInteger  
		month: (aDT copyFrom: 5 to: 6) asInteger
		year: (aDT copyFrom: 1 to: 4) asInteger.
	t _ Time readFrom: (aDT copyFrom: 10 to: 17) readStream.
	^ XMLRPCDateTime fromDate: d time: t
	! !

!XMLRPCDecoder methodsFor: 'as yet unclassified' stamp: 'chl 10/9/2001 01:39'!
decodeStruct: anXMLElement
	| dict |
	dict _ Dictionary new.
	((anXMLElement entityAt: 'value') entityAt: 'struct') entities keysAndValuesDo: [:key :val | 
		dict at: (((val value) entityAt: 'name') contentString) put: (self decode: val value)
		].
	^ dict! !


Object subclass: #XMLRPCEncoder
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Synerge-XML-RPC'!

!XMLRPCEncoder methodsFor: 'as yet unclassified' stamp: 'jam 4/19/2007 14:19'!
encode: aValue
	(aValue class = SmallInteger) ifTrue: [^ '<value><i4>', (aValue asString), '</i4></value>'].
	(aValue class = Float) ifTrue: [^ '<value><double>', (aValue asString), '</double></value>'].
	(aValue class = String) ifTrue: [^ '<value><string>', (aValue asString), '</string></value>'].
	(aValue class = ByteString) ifTrue: [^ '<value><string>', (aValue asString), '</string></value>'].
	(aValue class = True) ifTrue: [^ '<value><boolean>1</boolean></value>'].
	(aValue class = False) ifTrue: [^ '<value><boolean>0</boolean></value>'].
	(aValue class = XMLRPCDateTime) ifTrue: [^ '<value><dateTime.iso8601>', (self encodeDateTime: aValue), '</dateTime.iso8601></value>'].
	(aValue isStream) ifTrue: [^ '<value><base64>', ((Base64MimeConverter mimeEncode: aValue) contents), '</base64></value>'].
	(aValue class = Array) ifTrue: [^ '<value>', (self encodeArray: aValue), '</value>'].
	(aValue class = Dictionary) ifTrue: [^ '<value>', (self encodeStruct: aValue), '</value>'].
	self error: 'Cannot encode ', (aValue asString), ' (class: ', (aValue class asString), ')'! !

!XMLRPCEncoder methodsFor: 'as yet unclassified' stamp: 'chl 10/8/2001 01:45'!
encodeArray: anArray
	| r |
	r _ Text new.
	anArray do: [:elem | r append: (self encode: elem)].
	^ '<array><data>', (r asString), '</data></array>'! !

!XMLRPCEncoder methodsFor: 'as yet unclassified' stamp: 'chl 10/10/2001 00:46'!
encodeDateTime: aDateTime
	| date m d |
	date _ aDateTime date.
	((date monthIndex asString size) = 1) ifTrue: [m _ '0', date monthIndex asString] ifFalse: [m _ date monthIndex asString].
	((date dayOfMonth asString size) = 1) ifTrue: [d _ '0', date dayOfMonth asString] ifFalse: [d _ date dayOfMonth asString].
	^ (date year asString), m, d, 'T', (aDateTime time print24)! !

!XMLRPCEncoder methodsFor: 'as yet unclassified' stamp: 'chl 10/8/2001 01:47'!
encodeStruct: aDictionary
	| r |
	r _ Text new.
	aDictionary keysAndValuesDo: [:key :val | 
		r append: '<member><name>', key, '</name>', (self encode: val), '</member>' ].
	^ '<struct>', (r asString), '</struct>'! !


Object subclass: #XMLRPCRequest
	instanceVariableNames: 'endpoint method params'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Synerge-XML-RPC'!

!XMLRPCRequest methodsFor: 'as yet unclassified' stamp: 'chl 10/8/2001 02:58'!
build
	| p |
	p _ Text new.
	params do: [:param | p append: ('<param>', (XMLRPCEncoder new encode: param), '</param>')].
	^ '<?xml version="1.0"?>', (String crlf),'<methodCall><methodName>', method, '</methodName><params>', p ,'</params></methodCall>'
	! !

!XMLRPCRequest methodsFor: 'as yet unclassified' stamp: 'earl 10/20/2001 20:08'!
endpoint: anUrl
	endpoint _ anUrl.
	^ self.! !

!XMLRPCRequest methodsFor: 'as yet unclassified' stamp: 'jam 4/19/2007 15:03'!
execute	
	| s cmd crlf req list xmldoc  mystream auth zz |
	     mystream :=  'admin:admin' readStream.
	     auth := Base64MimeConverter mimeEncode: mystream.
	zz := auth contents. 
		s _  HTTPSocket initHTTPSocket: endpoint ifError: 'XML-RPC Transport Layer Error'. 
		crlf _ String crlf.
		req _ self build.
		cmd _ 'POST ', (endpoint fullPath), 
		' HTTP/1.0', crlf,
		'User-Agent: synerge SqXR', crlf,
		'Host: ', (endpoint authority), crlf,
		'Authorization: Basic ', zz , crlf,
		'Content-type: text/xml', crlf,
		'Content-length: ', (req size asString), crlf, crlf,
		req. 
		s sendCommand: cmd.
		
		list _ s getResponseUpTo: crlf, crlf ignoring: (String cr).	
			"list = header, CrLf, CrLf, beginningOfData"
			xmldoc _ XMLDOMParser parseDocumentFrom: (s getRestOfBuffer: (list at: 3)) contents readStream.
			(((xmldoc elementAt: 'methodResponse') elements at: 1) name = 'fault') ifTrue: [
					self error: 'XML-RPC error: ', ((XMLRPCDecoder new decode: ((xmldoc elementAt: 'methodResponse') entities at: 1) value) at: 'faultString')
							].
			^ XMLRPCDecoder new decode: (((xmldoc elementAt: 'methodResponse') elementAt: 'params') elementAt: 'param').
			"^ cmd, crlf, '- - - ', crlf, (s getRestOfBuffer: (list at: 3)) contents."
			! !

!XMLRPCRequest methodsFor: 'as yet unclassified' stamp: 'earl 10/20/2001 20:08'!
method: aString
	method _ aString.
	^ self.! !

!XMLRPCRequest methodsFor: 'as yet unclassified' stamp: 'earl 10/20/2001 20:24'!
params: anArray
	params _ anArray.
	^ self! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

XMLRPCRequest class
	instanceVariableNames: ''!

!XMLRPCRequest class methodsFor: 'as yet unclassified' stamp: 'jam 4/19/2007 14:23'!
endpoint: anUrl method: aString params: anArray
	^ self new endpoint: anUrl; method: aString; params: anArray! !