[squeak-dev] The Trunk: 60Deprecated-tpr.32.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Feb 19 03:34:41 UTC 2019


tim Rowledge uploaded a new version of 60Deprecated to project The Trunk:
http://source.squeak.org/trunk/60Deprecated-tpr.32.mcz

==================== Summary ====================

Name: 60Deprecated-tpr.32
Author: tpr
Time: 18 February 2019, 7:34:39.749893 pm
UUID: 563d119b-c74a-42cc-877d-33cb848d66c6
Ancestors: 60Deprecated-tpr.31

Part of deprecating HTTPClient for 6.0
Stop using it, deprecate HTTPClient, URI & subclasses

=============== Diff against 60Deprecated-tpr.31 ===============

Item was changed:
  SystemOrganization addCategory: #'60Deprecated-Collections-Streams'!
  SystemOrganization addCategory: #'60Deprecated-Kernel-Methods'!
  SystemOrganization addCategory: #'60Deprecated-System-Support'!
  SystemOrganization addCategory: #'60Deprecated-Tools-Inspector'!
  SystemOrganization addCategory: #'60Deprecated-Tools-Menus'!
+ SystemOrganization addCategory: #'60Deprecated-Network-URI'!

Item was added:
+ ----- Method: AutoStart class>>checkForPluginUpdate (in category '*60Deprecated') -----
+ checkForPluginUpdate
+ 	| pluginVersion updateURL |
+ 	HTTPClient isRunningInBrowser
+ 		ifFalse: [^false].
+ 	pluginVersion := Smalltalk namedArguments
+ 		at: (Smalltalk platformName copyWithout: Character space) asUppercase
+ 		ifAbsent: [^false].
+ 	updateURL := Smalltalk namedArguments
+ 		at: 'UPDATE_URL'
+ 		ifAbsent: [^false].
+ 	^SystemVersion check: pluginVersion andRequestPluginUpdate: updateURL!

Item was added:
+ ----- Method: AutoStart class>>checkForUpdates (in category '*60Deprecated') -----
+ checkForUpdates
+ 	| availableUpdate updateServer |
+ 	HTTPClient isRunningInBrowser ifFalse: [ ^ self processUpdates ].
+ 	availableUpdate := (Smalltalk namedArguments
+ 		at: 'UPDATE'
+ 		ifAbsent: [ '' ]) asInteger.
+ 	availableUpdate ifNil: [ ^ false ].
+ 	updateServer := Smalltalk namedArguments
+ 		at: 'UPDATESERVER'
+ 		ifAbsent:
+ 			[ Smalltalk namedArguments
+ 				at: 'UPDATE_SERVER'
+ 				ifAbsent: [ 'Squeakland' ] ].
+ 	UpdateStreamDownloader default setUpdateServer: updateServer.
+ 	^ SystemVersion checkAndApplyUpdates: availableUpdate!

Item was added:
+ Object subclass: #HTTPClient
+ 	instanceVariableNames: ''
+ 	classVariableNames: 'BrowserSupportsAPI RunningInBrowser'
+ 	poolDictionaries: ''
+ 	category: '60Deprecated-System-Support'!

Item was added:
+ ----- Method: HTTPClient class>>browserSupportsAPI (in category 'class initialization') -----
+ browserSupportsAPI
+ 	^BrowserSupportsAPI == true!

Item was added:
+ ----- Method: HTTPClient class>>browserSupportsAPI: (in category 'class initialization') -----
+ browserSupportsAPI: aBoolean
+ 	BrowserSupportsAPI := aBoolean!

Item was added:
+ ----- Method: HTTPClient class>>composeMailTo:subject:body: (in category 'utilities') -----
+ composeMailTo: address subject: subject body: body
+ 	"HTTPClient composeMailTo: 'michael.rueger at squeakland.org' subject: 'test subject' body: 'message' "
+ 	| mailTo |
+ 	mailTo := WriteStream on: String new.
+ 	mailTo nextPutAll: 'mailto:'.
+ 	mailTo
+ 		nextPutAll: address;
+ 		nextPut: $?.
+ 	subject isEmptyOrNil
+ 		ifFalse: [mailTo nextPutAll: 'subject='; nextPutAll: subject; nextPut: $&].
+ 	body isEmptyOrNil
+ 		ifFalse: [mailTo nextPutAll: 'body='; nextPutAll: body].
+ 
+ 	self httpGet: mailTo contents!

Item was added:
+ ----- Method: HTTPClient class>>determineIfRunningInBrowser (in category 'class initialization') -----
+ determineIfRunningInBrowser
+ 	"HTTPClient determineIfRunningInBrowser"
+ 
+ 	RunningInBrowser := StandardFileStream isRunningAsBrowserPlugin
+ !

Item was added:
+ ----- Method: HTTPClient class>>exampleMailTo (in category 'examples') -----
+ exampleMailTo
+ 	"HTTPClient exampleMailTo"
+ 
+ 	HTTPClient mailTo: 'm.rueger at acm.org' message: 'A test message from within Squeak'
+ !

Item was added:
+ ----- Method: HTTPClient class>>examplePostArgs (in category 'examples') -----
+ examplePostArgs
+ 	"HTTPClient examplePostArgs"
+ 
+ 	| args result |
+ 	args := Dictionary new
+ 		at: 'arg1' put: #('val1');
+ 		at: 'arg2' put: #('val2');
+ 		yourself.
+ 	result := HTTPClient httpPostDocument: 'http://www.squeaklet.com/cgi-bin/thrd.pl [^]' args: args.
+ 	Transcript show: result content; cr; cr.
+ 
+ !

Item was added:
+ ----- Method: HTTPClient class>>examplePostMultipart (in category 'examples') -----
+ examplePostMultipart
+ 	"HTTPClient examplePostMultipart"
+ 
+ 	| args result |
+ 	args := Dictionary new
+ 		at: 'arg1' put: #('val1');
+ 		at: 'arg2' put: #('val2');
+ 		yourself.
+ 	result := HTTPClient httpPostMultipart: 'http://www.squeaklet.com/cgi-bin/thrd.pl'  args: args.
+ 	Transcript show: result content; cr; cr.
+ 
+ !

Item was added:
+ ----- Method: HTTPClient class>>getDirectoryListing: (in category 'utilities') -----
+ getDirectoryListing: dirListURL
+ 	"HTTPClient getDirectoryListing: 'http://www.squeakalpha.org/uploads' "
+ 	| answer ftpEntries |
+ "	answer := self 
+ 		httpPostDocument: dirListURL
+ 		args: Dictionary new."
+ 	"Workaround for Mac IE problem"
+ 	answer := self httpGetDocument: dirListURL.
+ 	answer isString
+ 		ifTrue: [^self error: 'Listing failed: ' , answer]
+ 		ifFalse: [answer := answer content].
+ 	answer first == $<
+ 		ifTrue: [self error: 'Listing failed: ' , answer].
+ 	ftpEntries := answer findTokens: String crlf.
+ 	^ ftpEntries 
+ 		collect:[:ftpEntry | ServerDirectory parseFTPEntry: ftpEntry]
+ 		thenSelect: [:entry | entry notNil]!

Item was added:
+ ----- Method: HTTPClient class>>httpGet: (in category 'post/get') -----
+ httpGet: url
+ 	| document |
+ 	document := self httpGetDocument: url.
+ 	^(document isString)
+ 		ifTrue: [
+ 			"strings indicate errors"
+ 			document]
+ 		ifFalse: [(RWBinaryOrTextStream with: document content) reset]!

Item was added:
+ ----- Method: HTTPClient class>>httpGetDocument: (in category 'post/get') -----
+ httpGetDocument: url
+ 	| stream content | 
+ 	^self shouldUsePluginAPI
+ 		ifTrue: [
+ 			stream := FileStream requestURLStream: url ifError: [self error: 'Error in get from ' , url printString].
+ 			stream ifNil: [^''].
+ 			stream position: 0.
+ 			content := stream upToEnd.
+ 			stream close.
+ 			MIMEDocument content: content]
+ 		ifFalse: [HTTPSocket httpGetDocument: url]!

Item was added:
+ ----- Method: HTTPClient class>>httpPostDocument:args: (in category 'post/get') -----
+ httpPostDocument: url args: argsDict
+ 	^self httpPostDocument: url target: nil args: argsDict!

Item was added:
+ ----- Method: HTTPClient class>>httpPostDocument:target:args: (in category 'post/get') -----
+ httpPostDocument: url target: target args: argsDict
+ 	| argString stream content |
+ 	^self shouldUsePluginAPI
+ 		ifTrue: [
+ 			argString := argsDict
+ 				ifNotNil: [argString := HTTPSocket argString: argsDict]
+ 				ifNil: [''].
+ 			stream := FileStream post: argString , ' ' target: target url: url , argString ifError: [self error: 'Error in post to ' , url printString].
+ 			stream position: 0.
+ 			content := stream upToEnd.
+ 			stream close.
+ 			MIMEDocument content: content]
+ 		ifFalse: [HTTPSocket httpPostDocument: url  args: argsDict]!

Item was added:
+ ----- Method: HTTPClient class>>httpPostMultipart:args: (in category 'post/get') -----
+ httpPostMultipart: url args: argsDict
+ 	" do multipart/form-data encoding rather than x-www-urlencoded "
+ 
+ 	^self shouldUsePluginAPI
+ 		ifTrue: [self pluginHttpPostMultipart: url args: argsDict]
+ 		ifFalse: [HTTPSocket httpPostMultipart: url args: argsDict accept: nil request: '']!

Item was added:
+ ----- Method: HTTPClient class>>isRunningInBrowser (in category 'testing') -----
+ isRunningInBrowser
+ 
+ 	RunningInBrowser isNil
+ 		ifTrue: [self determineIfRunningInBrowser].
+ 	^RunningInBrowser!

Item was added:
+ ----- Method: HTTPClient class>>isRunningInBrowser: (in category 'testing') -----
+ isRunningInBrowser: aBoolean
+ 	"Override the automatic process.
+ 	This should be used with caution.
+ 	One way to determine it without using the primitive is to check for parameters typically only encountered when running as a plugin."
+ 
+ 	RunningInBrowser := aBoolean!

Item was added:
+ ----- Method: HTTPClient class>>mailTo:message: (in category 'utilities') -----
+ mailTo: address message: aString
+ 	HTTPClient shouldUsePluginAPI
+ 		ifFalse: [^self error: 'You need to run inside a web browser.'].
+ 	FileStream post: aString url: 'mailto:' , address ifError: [self error: 'Can not send mail']!

Item was added:
+ ----- Method: HTTPClient class>>pluginHttpPostMultipart:args: (in category 'private') -----
+ pluginHttpPostMultipart: url args: argsDict
+ 	| mimeBorder argsStream crLf resultStream result |
+ 	" do multipart/form-data encoding rather than x-www-urlencoded "
+ 
+ 	crLf := String crlf.
+ 	mimeBorder := '----squeak-', Time millisecondClockValue printString, '-stuff-----'.
+ 	"encode the arguments dictionary"
+ 	argsStream := WriteStream on: String new.
+ 	argsDict associationsDo: [:assoc |
+ 		assoc value do: [ :value | | fieldValue |
+ 		"print the boundary"
+ 		argsStream nextPutAll: '--', mimeBorder, crLf.
+ 		" check if it's a non-text field "
+ 		argsStream nextPutAll: 'Content-disposition: form-data; name="', assoc key, '"'.
+ 		(value isKindOf: MIMEDocument)
+ 			ifFalse: [fieldValue := value]
+ 			ifTrue: [argsStream nextPutAll: ' filename="', value url pathForFile, '"', crLf, 'Content-Type: ', value contentType.
+ 				fieldValue := (value content
+ 					ifNil: [(FileStream fileNamed: value url pathForFile) contentsOfEntireFile]
+ 					ifNotNil: [value content]) asString].
+ " Transcript show: 'field=', key, '; value=', fieldValue; cr. "
+ 		argsStream nextPutAll: crLf, crLf, fieldValue, crLf.
+ 	]].
+ 	argsStream nextPutAll: '--', mimeBorder, '--'.
+ 	resultStream := FileStream
+ 		post: 
+ 			('ACCEPT: text/html', crLf,
+ 			'User-Agent: Squeak 3.1', crLf,
+ 			'Content-type: multipart/form-data; boundary=', mimeBorder, crLf,
+ 			'Content-length: ', argsStream contents size printString, crLf, crLf, 
+ 			argsStream contents)
+ 		url: url ifError: [^'Error in post ' url asString].
+ 	"get the header of the reply"
+ 	result := resultStream
+ 		ifNil: ['']
+ 		ifNotNil: [resultStream upToEnd].
+ 	^MIMEDocument content: result!

Item was added:
+ ----- Method: HTTPClient class>>requestURL:target: (in category 'post/get') -----
+ requestURL: url target: target
+ 	^self shouldUsePluginAPI
+ 		ifTrue: [FileStream requestURL: url target: target]
+ 		ifFalse: [self error: 'Requesting a new URL target is not supported.']!

Item was added:
+ ----- Method: HTTPClient class>>shouldUsePluginAPI (in category 'testing') -----
+ shouldUsePluginAPI
+ 	"HTTPClient shouldUsePluginAPI" 
+ 
+ 	self isRunningInBrowser
+ 		ifFalse: [^false].
+ 	self browserSupportsAPI
+ 		ifFalse: [^false].
+ 	"The Mac plugin calls do not work in full screen mode"
+ 	^((Smalltalk platformName = 'Mac OS')
+ 		and: [DisplayScreen displayIsFullScreen]) not!

Item was added:
+ ----- Method: HTTPClient class>>uploadFileNamed:to:user:passwd: (in category 'utilities') -----
+ uploadFileNamed: aFilename to: baseUrl user: user passwd: passwd
+ 
+ 	| fileContents remoteFilename |
+ 	remoteFilename := (baseUrl endsWith: '/')
+ 		ifTrue: [baseUrl , '/' , aFilename]
+ 		ifFalse: [baseUrl , aFilename].
+ 	fileContents := (StandardFileStream readOnlyFileNamed: aFilename) contentsOfEntireFile.
+ 	HTTPSocket httpPut: fileContents to: remoteFilename user: user passwd: passwd!

Item was added:
+ URI subclass: #HierarchicalURI
+ 	instanceVariableNames: 'authority query'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: '60Deprecated-Network-URI'!

Item was added:
+ ----- Method: HierarchicalURI>>absoluteFromString:scheme: (in category 'private') -----
+ absoluteFromString: aString scheme: schemeName
+ 	| remainder |
+ 	super absoluteFromString: aString scheme: schemeName.
+ 
+ 	"We now have the interesting part in schemeSpecficPart and can parse it further"
+ 
+ 	"This check is somewhat redundant, just in case somebody calls this directly."
+ 	remainder := schemeSpecificPart.
+ 	(remainder isEmpty
+ 		or: [remainder first ~~ $/])
+ 		ifTrue: [(IllegalURIException new uriString: remainder) signal: 'Invalid absolute URI'].
+ 
+ 	(aString beginsWith: '//')
+ 		ifTrue: [remainder := self extractAuthority: (remainder copyFrom: 3 to: remainder size)].
+ 
+ 	self extractSchemeSpecificPartAndFragment: remainder!

Item was added:
+ ----- Method: HierarchicalURI>>absolutePath (in category 'accessing') -----
+ absolutePath
+ 	^self schemeSpecificPart isEmpty
+ 		ifTrue: ['/']
+ 		ifFalse: [self schemeSpecificPart]!

Item was added:
+ ----- Method: HierarchicalURI>>allButScheme (in category 'printing') -----
+ allButScheme
+ 	"Answer the entire url except its scheme"
+ 
+ 	^String streamContents:[:s|
+ 		authority ifNotNil:[self authority printOn: s].
+ 		s nextPutAll: super allButScheme.
+ 		query ifNotNil:[s nextPutAll: query].
+ 	].!

Item was added:
+ ----- Method: HierarchicalURI>>assureExistance (in category 'directory operations') -----
+ assureExistance
+ 	!

Item was added:
+ ----- Method: HierarchicalURI>>authority (in category 'accessing') -----
+ authority
+ 	^authority!

Item was added:
+ ----- Method: HierarchicalURI>>baseName (in category 'accessing') -----
+ baseName
+ 	"returns the last component stripped of its extension"
+ 
+ 	| baseName i |
+ 	baseName := self pathComponents last.
+ 	i := baseName findLast: [:c | c = $.].
+ 	^i = 0
+ 		ifTrue: [baseName]
+ 		ifFalse: [baseName copyFrom: 1 to: i-1].
+ !

Item was added:
+ ----- Method: HierarchicalURI>>buildAbsolutePath: (in category 'private') -----
+ buildAbsolutePath: pathComponents
+ 	^String streamContents: [:stream |
+ 		stream nextPut: $/.
+ 		pathComponents
+ 			do: [:pathPart | stream nextPutAll: pathPart]
+ 			separatedBy: [stream nextPut: $/]]!

Item was added:
+ ----- Method: HierarchicalURI>>extension (in category 'accessing') -----
+ extension
+ 	"This method assumes a $. as extension delimiter"
+ 
+ 	| i leafName |
+ 	leafName := self pathComponents last.
+ 	i := leafName findLast: [:c | c = $.].
+ 	^i = 0
+ 		ifTrue: ['']
+ 		ifFalse: [leafName copyFrom: i + 1 to: leafName size].
+ !

Item was added:
+ ----- Method: HierarchicalURI>>extractAuthority: (in category 'private') -----
+ extractAuthority: aString
+ 	| endAuthorityIndex authorityString |
+ 	endAuthorityIndex := (aString indexOf: $/ ) - 1.
+ 	endAuthorityIndex < 0
+ 		ifTrue: [endAuthorityIndex := aString size].
+ 	authorityString := aString copyFrom: 1 to: endAuthorityIndex.
+ 	authority := URIAuthority fromString: authorityString.
+ 	^aString copyFrom: endAuthorityIndex+1 to: aString size!

Item was added:
+ ----- Method: HierarchicalURI>>extractQuery: (in category 'private') -----
+ extractQuery: remainder
+ 	| queryIndex |
+ 	queryIndex := remainder indexOf: $?.
+ 	queryIndex > 0
+ 		ifFalse: [^remainder].
+ 	query := remainder copyFrom: queryIndex to: remainder size.
+ 	^remainder copyFrom: 1 to: queryIndex-1!

Item was added:
+ ----- Method: HierarchicalURI>>extractSchemeSpecificPartAndFragment: (in category 'private') -----
+ extractSchemeSpecificPartAndFragment: remainder
+ 	super extractSchemeSpecificPartAndFragment: remainder.
+ 	schemeSpecificPart := self extractQuery: schemeSpecificPart!

Item was added:
+ ----- Method: HierarchicalURI>>host (in category 'accessing') -----
+ host
+ 	^self authority host!

Item was added:
+ ----- Method: HierarchicalURI>>path (in category 'accessing') -----
+ path
+ "	^self schemeSpecificPart isEmpty
+ 		ifTrue: ['/']
+ 		ifFalse: [self schemeSpecificPart]"
+ 	^self schemeSpecificPart!

Item was added:
+ ----- Method: HierarchicalURI>>pathComponents (in category 'accessing') -----
+ pathComponents
+ 	^self path findTokens: $/!

Item was added:
+ ----- Method: HierarchicalURI>>port (in category 'accessing') -----
+ port
+ 	^self authority port!

Item was added:
+ ----- Method: HierarchicalURI>>printSchemeSpecificPartOn: (in category 'printing') -----
+ printSchemeSpecificPartOn: stream
+ 	self isAbsolute
+ 		ifTrue: [stream nextPutAll: '//'].
+ 	authority
+ 		ifNotNil: [self authority printOn: stream].
+ 	super printSchemeSpecificPartOn: stream.
+ 	query
+ 		ifNotNil: [stream nextPutAll: query]!

Item was added:
+ ----- Method: HierarchicalURI>>query (in category 'accessing') -----
+ query
+ 	^query!

Item was added:
+ ----- Method: HierarchicalURI>>relativeFromString: (in category 'private') -----
+ relativeFromString: aString
+ 	| remainder authorityEnd |
+ 	remainder := (aString beginsWith: '//')
+ 		ifTrue: [
+ 			authorityEnd := aString indexOf: $/ startingAt: 3.
+ 			authorityEnd = 0
+ 				ifTrue: [authorityEnd := aString size+1].
+ 			self extractAuthority: (aString copyFrom: 3 to: authorityEnd-1)]
+ 		ifFalse: [aString].
+ 	self extractSchemeSpecificPartAndFragment: remainder!

Item was added:
+ ----- Method: HierarchicalURI>>removeComponentDotDotPairs: (in category 'private') -----
+ removeComponentDotDotPairs: pathComponents
+ 	| dotDotIndex |
+ 	dotDotIndex := pathComponents indexOf: '..'.
+ 	[dotDotIndex > 1]
+ 		whileTrue: [
+ 			pathComponents
+ 				removeAt: dotDotIndex;
+ 				removeAt: dotDotIndex-1.
+ 			dotDotIndex := pathComponents indexOf: '..']!

Item was added:
+ ----- Method: HierarchicalURI>>resolveRelativeURI: (in category 'accessing') -----
+ resolveRelativeURI: aURI
+ 	| relativeURI newAuthority newPath pathComponents newURI relComps |
+ 	relativeURI := aURI asURI.
+ 
+ 	relativeURI isAbsolute
+ 		ifTrue: [^relativeURI].
+ 
+ 	relativeURI authority
+ 		ifNil: [
+ 			newAuthority := self authority.
+ 			(relativeURI path beginsWith: '/')
+ 				ifTrue: [newPath := relativeURI path]
+ 				ifFalse: [
+ 					pathComponents := (self path copyUpToLast: $/) findTokens: $/.
+ 					relComps := relativeURI pathComponents.
+ 					relComps removeAllSuchThat: [:each | each = '.'].
+ 					pathComponents addAll: relComps.
+ 					pathComponents removeAllSuchThat: [:each | each = '.'].
+ 					self removeComponentDotDotPairs: pathComponents.
+ 					newPath := self buildAbsolutePath: pathComponents.
+ 					((relComps isEmpty
+ 						or: [relativeURI path last == $/ 
+ 						or: [(relativeURI path endsWith: '/..')
+ 						or: [relativeURI path = '..'
+ 						or: [relativeURI path endsWith: '/.' ]]]])
+ 						and: [newPath size > 1])
+ 						ifTrue: [newPath := newPath , '/']]]
+ 		ifNotNil: [
+ 			newAuthority := relativeURI authority.
+ 			newPath := relativeURI path].
+ 
+ 	newURI := String streamContents: [:stream |
+ 		stream nextPutAll: self scheme.
+ 		stream nextPut: $: .
+ 		newAuthority notNil
+ 			ifTrue: [
+ 				stream nextPutAll: '//'.
+ 				newAuthority printOn: stream].
+ 		newPath notNil
+ 			ifTrue: [stream nextPutAll: newPath].
+ 		relativeURI query notNil
+ 			ifTrue: [stream nextPutAll: relativeURI query].
+ 		relativeURI fragment notNil
+ 			ifTrue: [
+ 				stream nextPut: $# .
+ 				stream nextPutAll: relativeURI fragment]].
+ 	^newURI asURI!

Item was added:
+ ----- Method: HierarchicalURI>>userInfo (in category 'accessing') -----
+ userInfo
+ 	^self authority userInfo!

Item was added:
+ URI subclass: #OpaqueURI
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: '60Deprecated-Network-URI'!

Item was added:
+ ----- Method: OpaqueURI>>isOpaque (in category 'testing') -----
+ isOpaque
+ 	^true!

Item was added:
+ ----- Method: SystemVersion class>>check:andRequestPluginUpdate: (in category '*60Deprecated-testing method dictionary') -----
+ check: pluginVersion andRequestPluginUpdate: updateURL
+ 	"SystemVersion check: 'zzz' andRequestPluginUpdate: 'http://www.squeakland.org/installers/update.html' "
+ 
+ 	"We don't have a decent versioning scheme yet, so we are basically checking for a nil VM version on the mac."
+ 	(self pluginVersion: pluginVersion newerThan: self currentPluginVersion)
+ 		ifFalse: [^true].
+ 	(self confirm: 'There is a newer plugin version available. Do you want to install it now?')
+ 		ifFalse: [^false].
+ 	HTTPClient
+ 		requestURL: updateURL , (Smalltalk platformName copyWithout: Character space) asLowercase , '.html'
+ 		target: '_top'.
+ 	^false!

Item was added:
+ Object subclass: #URI
+ 	instanceVariableNames: 'fragment scheme schemeSpecificPart'
+ 	classVariableNames: 'ClientClasses'
+ 	poolDictionaries: ''
+ 	category: '60Deprecated-Network-URI'!
+ 
+ !URI commentStamp: 'tpr 2/18/2019 18:06' prior: 0!
+ This class is deprecated. Consider using one of the Url classes instead.
+ 
+ A Uniform Resource Identifier (URI) is a compact string of characters for identifying an abstract or physical resource.
+ This implementation is based on http://www.ietf.org/rfc/rfc2396.txt.
+ 
+ !

Item was added:
+ ----- Method: URI class>>absoluteFromString:scheme: (in category 'instance creation') -----
+ absoluteFromString: aString scheme: scheme
+ 	| remainder |
+ 	remainder := aString copyFrom: scheme size+2 to: aString size.
+ 	remainder isEmpty
+ 		ifTrue: [(IllegalURIException new uriString: aString) signal: 'Invalid absolute URI'].
+ 	^(remainder first = $/
+ 		ifTrue: [HierarchicalURI]
+ 		ifFalse: [OpaqueURI]) new absoluteFromString: remainder scheme: scheme!

Item was added:
+ ----- Method: URI class>>basicNew (in category 'instance creation') -----
+ basicNew
+ 	self deprecated: 'This class is deprecated. USe one ofthe Url classes instead'.
+ 	^super basicNew!

Item was added:
+ ----- Method: URI class>>extractSchemeFrom: (in category 'instance creation') -----
+ extractSchemeFrom: aString
+ 	| colonIndex slashIndex |
+ 	colonIndex := aString indexOf: $: .
+ 	^colonIndex > 0
+ 		ifTrue: [
+ 			slashIndex := aString indexOf: $/ .
+ 			(slashIndex = 0
+ 				or: [colonIndex < slashIndex])
+ 				ifTrue: [aString copyFrom: 1 to: colonIndex-1]
+ 				ifFalse: [nil]]
+ 		ifFalse: [nil]!

Item was added:
+ ----- Method: URI class>>fromString: (in category 'instance creation') -----
+ fromString: aString
+ 	| parseString scheme |
+ 	parseString := aString withBlanksTrimmed.
+ 	scheme := self extractSchemeFrom: parseString.
+ 	^scheme
+ 		ifNil: [HierarchicalURI new relativeFromString: aString]
+ 		ifNotNil: [self absoluteFromString: aString scheme: scheme]
+ !

Item was added:
+ ----- Method: URI class>>initialize (in category 'class initialization') -----
+ initialize
+ 	"URI initialize"
+ 
+ 	ClientClasses := Dictionary new.
+ 	ClientClasses
+ 		at: 'http' put: #HTTPClient;
+ 		at: 'ftp' put: #FTPClient;
+ 		at: 'file' put: #FileDirectory
+ !

Item was added:
+ ----- Method: URI>>= (in category 'testing') -----
+ = otherURI
+ 	^ self class = otherURI class
+ 		and: [self asString = otherURI asString]!

Item was added:
+ ----- Method: URI>>absoluteFromString:scheme: (in category 'private') -----
+ absoluteFromString: remainder scheme: schemeName
+ 	scheme := schemeName.
+ 	self extractSchemeSpecificPartAndFragment: remainder!

Item was added:
+ ----- Method: URI>>allButScheme (in category 'printing') -----
+ allButScheme
+ 	"Answer the entire url except its scheme"
+ 
+ 	^String streamContents:[:s|
+ 		s nextPutAll: schemeSpecificPart.
+ 		fragment ifNotNil: [
+ 			s nextPut: $# .
+ 			s nextPutAll: self fragment]
+ 	].!

Item was added:
+ ----- Method: URI>>asText (in category 'converting') -----
+ asText
+ 	^self asString asText!

Item was added:
+ ----- Method: URI>>asURI (in category 'converting') -----
+ asURI
+ 	^self!

Item was added:
+ ----- Method: URI>>asUrl (in category 'converting') -----
+ asUrl
+ 
+ 	^self asString asUrl!

Item was added:
+ ----- Method: URI>>clientClass (in category 'private') -----
+ clientClass
+ 	^Smalltalk at: (ClientClasses at: self scheme ifAbsent: [ClientClasses at: 'file'])!

Item was added:
+ ----- Method: URI>>contentStream (in category 'retrieval') -----
+ contentStream
+ 	^self clientClass contentStreamForURI: self!

Item was added:
+ ----- Method: URI>>downloadUrl (in category 'converting') -----
+ downloadUrl
+ 	self halt!

Item was added:
+ ----- Method: URI>>extractSchemeSpecificPartAndFragment: (in category 'private') -----
+ extractSchemeSpecificPartAndFragment: remainder
+ 	| fragmentIndex |
+ 	fragmentIndex := remainder indexOf: $# .
+ 	fragmentIndex > 0
+ 		ifTrue: [
+ 			schemeSpecificPart := remainder copyFrom: 1 to: fragmentIndex-1.
+ 			fragment := remainder copyFrom: fragmentIndex+1 to: remainder size]
+ 		ifFalse: [schemeSpecificPart := remainder]!

Item was added:
+ ----- Method: URI>>fragment (in category 'accessing') -----
+ fragment
+ 	^fragment!

Item was added:
+ ----- Method: URI>>hasRemoteContents (in category 'testing') -----
+ hasRemoteContents
+ 	self halt!

Item was added:
+ ----- Method: URI>>hash (in category 'testing') -----
+ hash
+ 	^ self asString hash!

Item was added:
+ ----- Method: URI>>isAbsolute (in category 'testing') -----
+ isAbsolute
+ 	^self scheme notNil!

Item was added:
+ ----- Method: URI>>isOpaque (in category 'testing') -----
+ isOpaque
+ 	^false!

Item was added:
+ ----- Method: URI>>isRelative (in category 'testing') -----
+ isRelative
+ 	^self isAbsolute not!

Item was added:
+ ----- Method: URI>>printOn: (in category 'printing') -----
+ printOn: stream
+ 	self isAbsolute
+ 		ifTrue: [
+ 			stream nextPutAll: self scheme.
+ 			stream nextPut: $: ].
+ 	self printSchemeSpecificPartOn: stream.
+ 	fragment
+ 		ifNotNil: [
+ 			stream nextPut: $# .
+ 			stream nextPutAll: self fragment]
+ !

Item was added:
+ ----- Method: URI>>printSchemeSpecificPartOn: (in category 'printing') -----
+ printSchemeSpecificPartOn: stream
+ 	stream nextPutAll: self schemeSpecificPart!

Item was added:
+ ----- Method: URI>>resolveRelativeURI: (in category 'accessing') -----
+ resolveRelativeURI: relativeURI
+ 	self shouldNotImplement!

Item was added:
+ ----- Method: URI>>retrieveContentStream (in category 'retrieval') -----
+ retrieveContentStream
+ 	^self retrieveMIMEDocument contentStream!

Item was added:
+ ----- Method: URI>>retrieveContents (in category 'retrieval') -----
+ retrieveContents
+ 	^self retrieveMIMEDocument contents!

Item was added:
+ ----- Method: URI>>retrieveMIMEDocument (in category 'retrieval') -----
+ retrieveMIMEDocument
+ 	^self clientClass retrieveMIMEDocument: self!

Item was added:
+ ----- Method: URI>>scheme (in category 'accessing') -----
+ scheme
+ 	^scheme!

Item was added:
+ ----- Method: URI>>schemeSpecificPart (in category 'private') -----
+ schemeSpecificPart
+ 	^schemeSpecificPart!



More information about the Squeak-dev mailing list