Soap Maps.... apachens:Map [SOAP]

Giovanni Giorgi jj at objectsroot.com
Sun Oct 26 11:06:20 UTC 2003


umejava at mars.dti.ne.jp wrote:

>Hi,
>
>I've just written a simple patch. Hope this helps.
>Now you can add your custom coplex types to the SoapDecoder.
>(Please see SoapDecoder class >>example1)
>  
>
Thank you very much!!!
 
I have initiallized it with
    SoapDecoder initialize.
    SoapDecoder example1.
and all works fine now!
I have changed the method  SoapApachensMap>>fromXmlElement:
to avoid the call to asNumber on the last child params (so it can be 
what you like).
I send to you the fileout.

This "apache type" is very important because is used in perl to send 
hashtable, so we can obtain a great
interoperability with it.

By the way, I am developing a universal soap proxy, which can be used to 
send remote call as it was local.

For Example, the code:

| call |
    "invoke 'reverseArray' service of 'swikis.ddo.jp'(SoapOpera server)"
    call := (SoapCallEntry tcpHost: 'swikis.ddo.jp' port: 8823) newCall.
    call methodName: 'reverseString'.
    call addParameterNamed: #aString value: ('Hello from: ', Utilities 
authorInitials ).
    call invokeAndReturn.

can be rewritten as:
| proxy |
    proxy _ PIMSoapProxy proxyURL:'http://swikis.ddo.jp:8823'  
namespace:nil.
    proxy reverseString: {#aString. 'Hello baby'}.

It is more... "beautiful"  with single shot call:
|p|
p := PIMSoapProxy  proxyURL: 'http://www.siforge.org/myCgi.cgi' 
namespace: 'http://siforge/SIForge/Articles/CatalogApp'
p callMyMethodWithoutParams

I send you the alpha code.
It is very simple, and I plan to improve it if you think it is a good idea.
If you want include it  in the next version of  SoapOpera drop me an 
email  ;)
Good sunday!

> [...]
>
>Happy Soaping!
>  
>
You too ;)))


-- 
  [   [  [ JJ ]  ]   ]  | First, they ignore you. Then they laugh  
                        | at you. Then they fight you. Then you win
http://www.siforge.org  |          Mahatma Ghandi

-------------- next part --------------
'From Squeak3.5 of ''11 April 2003'' [latest update: #5180] on 26 October 2003 at 11:44:41 am'!
Object subclass: #PIMSoapProxy
	instanceVariableNames: 'namespace soapURI soapHost soapPort '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SIForgePIM-Sync'!
!PIMSoapProxy commentStamp: 'gg 10/26/2003 11:44' prior: 0!
I am a universal Soap Proxy.
I implement a simple RemoteProxy Design Pattern.

For Example, the code:

| call |
	"invoke 'reverseArray' service of 'swikis.ddo.jp'(SoapOpera server)"
	call := (SoapCallEntry tcpHost: 'swikis.ddo.jp' port: 8823) newCall.
	call methodName: 'reverseString'.
	call addParameterNamed: #aString value: ('Hello from: ', Utilities authorInitials ).
	call invokeAndReturn.

can be rewritten as:
| proxy |
	proxy _ PIMSoapProxy proxyURL:'http://swikis.ddo.jp:8823'  namespace:nil.
	proxy reverseString: {#aString. 'Hello baby'}.

Version 0.0 by Giovanni Giorgi <jj at objectsroot.com>
gg 10/26/2003 11:44!


!PIMSoapProxy methodsFor: 'soap' stamp: 'gg 10/26/2003 11:08'!
call: aMethod withParams: anArray
	|call retObj|
	call _ self callEntry.
	call methodName: aMethod.
	call addParameters: anArray.
	retObj _ call invokeAndReturn.
	^retObj.! !

!PIMSoapProxy methodsFor: 'soap' stamp: 'gg 10/26/2003 11:13'!
callEntry
	"Return a configured call entry"
	|  call |	
	call := (SoapCallEntry tcpHost: soapHost port: soapPort) newCall.
	"Note: this code is adpated to the PIM needs,  so feel free to modify it"
	namespace ifNotNil:[
		call targetObjectURI: soapURI.		
		call namespace: namespace.
	].
	^call.! !

!PIMSoapProxy methodsFor: 'soap' stamp: 'gg 10/24/2003 21:56'!
proxyURL: aFullURL namespace: aNameSpace
	"This method setup a soap proxy(url)"
	| tokens |

	soapURI _ aFullURL.
	tokens _ aFullURL findTokens: ':/'.
	soapHost _ tokens at: 2.
	(tokens at: 3) isAllDigits
		ifTrue: [soapPort _ (tokens at: 3) asNumber]
		ifFalse: [soapPort _ 80].
	namespace _aNameSpace.! !


!PIMSoapProxy methodsFor: 'proxying' stamp: 'gg 10/26/2003 11:38'!
doesNotUnderstand: aMessage
	"Proxy in action."
	|soapSelector s args|
	s_ aMessage selector asString.
	"Now mutate the selector: We must cut the  ':' "
	soapSelector _ ''.
	(s findTokens:$:) do:[:p|
		soapSelector _ soapSelector ,p.
	].
	args _aMessage arguments.
	^self call: soapSelector withParams: args.! !

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

PIMSoapProxy class
	instanceVariableNames: ''!

!PIMSoapProxy class methodsFor: 'instance creation' stamp: 'gg 10/26/2003 10:29'!
proxyURL: aFullURL namespace: aNameSpace
	^super new proxyURL: aFullURL namespace: aNameSpace.! !
-------------- next part --------------
'From Squeak3.5 of ''11 April 2003'' [latest update: #5180] on 26 October 2003 at 11:59:55 am'!

!SoapApachensMap class methodsFor: 'instance creation' stamp: 'gg 10/26/2003 11:59'!
fromXmlElement: aParsedXmlElement 
	| inst |
	inst := self new.
	aParsedXmlElement children
		do: [:eachItem | 
			| assoc | 
			assoc := eachItem children first value -> eachItem children last value.
			inst add: assoc].
	^ inst! !


More information about the Squeak-dev mailing list