[ENH][FIX] URL arguments

Michael Rueger Michael.Rueger.-ND at disney.com
Wed Mar 1 23:06:11 UTC 2000


Change Set:		URL-mir
Date:			3 August 1999
Author:			Michael Rueger

Adds a method to build a list of URL args without encoding the arguments.
Usefull if you have args already containing special characters.
Also adds a class URLArgumentList which does not change the order of
arguments.

-- 

 "To improve is to change, to be perfect is to change often." 
                                            Winston Churchill
+------------------------------------------------------------+
| Michael Rueger                                             |
| Phone: ++1 (818) 623 3283        Fax:   ++1 (818) 623 3559 |
+---------- Michael.Rueger.-ND at corp.go.com ------------------+
-------------- next part --------------
"Change Set:		URL-mir
Date:			3 August 1999
Author:			Michael Rueger

Adds a method to build a list of URL args without encoding the arguments. Usefull if you have args already containing special characters.
Also adds a class URLArgumentList which does not change the order of arguments.
"!

!HTTPSocket class methodsFor: 'utilities' stamp: 'mir 7/28/1999 15:52'!
argStringUnencoded: args
	"Return the args in a long string, as encoded in a url"

	| argsString first |
	args class == String ifTrue: ["sent in as a string, not a dictionary"
		^ (args first = $? ifTrue: [''] ifFalse: ['?']), args].
	argsString _ WriteStream on: String new.
	argsString nextPut: $?.
	first _ true.
	args associationsDo: [ :assoc |
		assoc value do: [ :value |
			first ifTrue: [ first _ false ] ifFalse: [ argsString nextPut: $& ].
			argsString nextPutAll: assoc key.
			argsString nextPut: $=.
			argsString nextPutAll: value. ] ].
	^ argsString contents
! !

OrderedCollection subclass: #UrlArgumentList
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Network-Url'!

!UrlArgumentList methodsFor: 'enumerating' stamp: 'mir 7/27/1999 16:01'!
associationsDo: aBlock
	self do: [:each | 
		aBlock value: each]! !


!UrlArgumentList methodsFor: 'private' stamp: 'mir 7/27/1999 16:20'!
argumentNamed: argName
	^self
		detect: [:each | each key = argName]
		ifNone: [nil]! !


!UrlArgumentList methodsFor: 'adding' stamp: 'mir 7/27/1999 16:19'!
add: argName value: argValue
	| argAssociation |
	argAssociation _ self argumentNamed: argName.
	argAssociation isNil
		ifTrue: [self add: (argName -> (OrderedCollection with: argValue))]
		ifFalse: [argAssociation value add: argValue]! !

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

UrlArgumentList class
	instanceVariableNames: ''!

!UrlArgumentList class methodsFor: 'instance creation' stamp: 'mir 7/27/1999 16:25'!
with: argAssoc
	| argList |
	argList _ self new.
	argList add: argAssoc key value: argAssoc value.
	^argList! !

!UrlArgumentList class methodsFor: 'instance creation' stamp: 'mir 7/27/1999 16:26'!
with: firstArgAssoc with: secondArgAssoc
	| argList |
	argList _ self with: firstArgAssoc.
	argList add: secondArgAssoc key value: secondArgAssoc value.
	^argList! !

!UrlArgumentList class methodsFor: 'instance creation' stamp: 'mir 7/27/1999 16:26'!
with: firstArgAssoc with: secondArgAssoc with: thirdArgAssoc
	| argList |
	argList _ self with: firstArgAssoc with: secondArgAssoc.
	argList add: thirdArgAssoc key value: thirdArgAssoc value.
	^argList! !


More information about the Squeak-dev mailing list