From VisualWorks®, 7.6 of March 3, 2008 on March 3, 2008 at 9:47:04 pm (Dialog confirm: 'You are filing-in a Parcel source file!\\While this is possible it will not have\the same effect as loading the parcel.\None of the Parcel''s prerequisites will\be loaded and none of its load actions\will be performed.\\Are you sure you want to file-in?' withCRs) ifFalse: [self error: 'Parcel file-in abandoned. Choose terminate or close.'] <class> <name>URLEncoder</name> <environment>OS</environment> <super>Core.StreamEncoder</super> <private>false</private> none urlSpecials urlSpecials <imports></imports> <category>URISupport</category> <attributes> <package>URISupport</package> </attributes> </class> <comment> OS.URLEncoder
This encodes and decodes strings using the W3C url-encoded format. Examples of use are URLEncoder new encode: 'fee fie ** foe fum' (URLEncoder new charset: #'utf-16') encode: 'fee fie ** foe fum' URLEncoder new decode: 'fee+fie+%2A%2A+foe%09fum' (URLEncoder new charset: #'utf-16') decode: 'fee+fie+%2A%00%2A%00+foe%09%00fum' The implementation is quite complicated.
</comment> <class> <name>URI</name> <environment>OS</environment> <super>Core.Object</super> <private>false</private> none <imports></imports> <category>Net-Resources</category> <attributes> <package>URISupport</package> </attributes> </class> <comment> OS.URI
URI represents a Uniform Resource Identifier, which is a standardized string representation of the address of data on the net. These can be broken down into URLs and URNs. In general, an URL specifies an address which specifically names the computer which supplies the resource, and an URN specifies an abstract name which must be resolved to a specific computer name by the client at runtime, but this distinction is not necessarily followed in detail by the various URI types in use. In this framework, only URLs have been implemented, since currently the design and implementation of URNs is in flux, and the infrastructure is not fully developed. Subclasses must implement the following messages: accessing asString resource stream creation binaryReadStream binaryWriteStream readStreamDo: writeStreamDo: Subclasses must implement the following class side messages: accessing protocol
</comment> <class> <name>URL</name> <environment>OS</environment> <super>OS.URI</super> <private>false</private> none <imports></imports> <category>Net-Resources</category> <attributes> <package>URISupport</package> </attributes> </class> <comment> OS.URL
URL is a class which represents those URIs that, usually, explicitly or implicitly identify the host computer which supplies the named resource, as opposed to URNs which require the host computer to be resolved at runtime via an unspecified mechanism. However, there have been some URLs developed which do not explicitly identify the server, so that this distinction is not rigid. However, URNs begin with "urn:" and usually use : as the separator between fields, and URLs may or may not begin with "url:", and usually use / to separate fields.
</comment> <class> <name>UnknownURLType</name> <environment>OS</environment> <super>OS.URL</super> <private>false</private> none protocol data <imports></imports> <category>Net-Resources</category> <attributes> <package>URISupport</package> </attributes> </class> <comment> OS.UnknownURLType
UnknownURLType is created when there is no URL class matching the protocol of a URI string. It can be manipulated to limited extents but cannot retrieve any data. Instance Variables: data <String> everything in the URL after the protocol protocol <String> the data transfer protocol name requested
</comment> <class> <name>ComponentNotLoaded</name> <environment>OS</environment> <super>Core.Exception</super> <private>false</private> none defaultValueBlock <imports></imports> <category>Net-Resources</category> <attributes> <package>URISupport</package> </attributes> </class> <comment> OS.ComponentNotLoaded
ComponentNotLoaded exception will be raised when the Http or Ftp url is created and one of the component HTTP or FTP is not loaded. Instance Variables: defaultValueBlock <aBlock> default value block
</comment> <class> <name>URLwithPath</name> <environment>OS</environment> <super>OS.URL</super> <private>false</private> none path query fragment <imports></imports> <category>Net-Resources</category> <attributes> <package>URISupport</package> </attributes> </class> <comment> OS.URLwithPath
URLwithPath uses the general syntax "protocol://host/path", where path may be composed of multiple segments separated by /, and where the host is usually the DNS name of a computer, but in subclasses such as FtpURL, the host may be more complex. Subclasses must implement the following messages: initialize parseHost: Instance Variables: fragment <String> When the URL contains #, what follows is an address to a specific location within the resource. The interpretation of the address depends on the MIME type of the resource. path <Array of: String> The components of the path which tells the server where to find the resource query <String> If the URL contains a ?, what follows is the argument for the resource. In this case, the assumption is that the resource is a program of some type, such as a CGI or a database query, and the query part of the URL specifies the arguments.
</comment> <class> <name>PartialURL</name> <environment>OS</environment> <super>OS.URLwithPath</super> <private>false</private> none <imports></imports> <category>RelativeURL</category> <attributes> <package>URISupport</package> </attributes> </class> <comment> OS.PartialURL
Represents a URL without a protocol part, eg: '/path/file.ext' asURI or 'relativepath/file.ext?query#fragment' asURI. These partial URLs can be combined with other partial URLs or full URLs so long as the URL scheme includes a path (ie: subclasses from URLwithPath). Examples: 'http://localhost/' asURI, 'images/example.jpg' 'http://localhost/subdirectory/' asURI, 'myfile.ext'
</comment> <class> <name>URLwithAuthority</name> <environment>OS</environment> <super>OS.URLwithPath</super> <private>false</private> none host port <imports></imports> <category>Net-Resources</category> <attributes> <package>URISupport</package> </attributes> </class> <comment> OS.URLwithAuthority
URLwithAuthority is super class for URL subclasses that are supporting host and port protocol server = [ [ userinfo "@" ] hostport ] Subclasses must implement the following messages: accessing client Instance Variables: host <String> host name port <Number> port number
</comment> <class> <name>UriEncodedStreamConstructor</name> <environment>OS</environment> <super>Core.EncodedStreamConstructor</super> <private>false</private> none <imports></imports> <category>Net-Resources</category> <attributes> <package>URISupport</package> </attributes> </class> <comment> OS.UriEncodedStreamConstructor
This class supports composing the description of a stream (which is named by a URI) with its encoding and any other interesting attributes, then creating the stream.
</comment> <class> <name>FileURL</name> <environment>OS</environment> <super>OS.URLwithPath</super> <private>false</private> none missingSlashes host <imports></imports> <category>Net-Resources</category> <attributes> <package>URISupport</package> </attributes> </class> <comment> OS.FileURL
FileURL represents an URL with the protocol 'file:', representing a file on the local hard disk or, rarely, on another computer on the LAN. Accessing the resource is done by converting the URL to a Filename and opening the file. Instance Variables: host <String | nil> File URL syntax ideally is file://host/path. Usually, the host is empty, and the file name starts with three / characters, but (especially on Windows) we support a non-empty host, which translates to file names of the form "\\host\path". missingSlashes <Boolean> true if, when the URL was created, the syntax used was host file syntax, and false if the URL used the portable, platform independent syntax that uses / as the separator.
</comment> <name>AutoloadHttps</name> <environment>OS.URI</environment> <private>false</private> <constant>false</constant> <category>Autoload</category> <initializer></initializer> <attributes> <package>URISupport</package> </attributes> <name>ProtocolToClassCache</name> <environment>OS.URI</environment> <private>false</private> <constant>true</constant> <category>Optimization</category> <initializer>Dictionary new: 5</initializer> <attributes> <package>URISupport</package> </attributes> <name>AutoloadHttp</name> <environment>OS.URI</environment> <private>false</private> <constant>false</constant> <category>Autoload</category> <initializer></initializer> <attributes> <package>URISupport</package> </attributes> <name>AutoloadFtp</name> <environment>OS.URI</environment> <private>false</private> <constant>false</constant> <category>Autoload</category> <initializer></initializer> <attributes> <package>URISupport</package> </attributes> <methods> OS.URLEncoder <category>utility</category>
decode: aString "This is frightening. We want to advance the inner stream unless we see %, in which case we go to the outer stream. And for state-changing encoders, we need to know that nil character doesn't necessarily indicate an error" | result | result := WriteStream on: (String new: aString size). self decode: aString onto: result. ^result contents.
decode: aString onto: resultStream "This is frightening. We want to advance the inner stream unless we see %, in which case we go to the outer stream. And for state-changing encoders, we need to know that nil character doesn't necessarily indicate an error" | outermostDecoder urlDecoder realCharacterStream | outermostDecoder := self decodingStreamOn: aString. urlDecoder := outermostDecoder stream. realCharacterStream := urlDecoder stream. [urlDecoder atEnd] whileFalse: [| nextThing mode | mode := outermostDecoder encoder readMode. nextThing := realCharacterStream peek = $% ifTrue: [outermostDecoder next] ifFalse: [urlDecoder next]. (outermostDecoder encoder readMode == mode) ifTrue: [nextThing isNil ifTrue: [ nextThing := (UnsupportedCharacterError new) messageText: #errNoCharacter << #dialogs >> 'No character available'; raise]]. nextThing isNil ifFalse: [resultStream nextPut: nextThing asCharacter]].
encode: aString ^(self encodingStream) nextPutAll: aString; close; encodedContents.
encode: aString onto: aStream ^(self encodingStreamOn: aStream) nextPutAll: aString; close.
</methods> <methods> OS.URLEncoder <category>querying</category>
characterSize: char "Return the size in bytes of <char>." ^(self isValidURLCharacter: char) ifTrue: [1] ifFalse: [3].
isValidURLCharacter: aCharacter "Return true if this character is one we can expect to see in a URL when decoding it. Note that this excludes the escapes, because we expect them to have been translated away before this is asked. See http://www.w3.org/Addressing/URL/5_BNF.html" | char | char := aCharacter asCharacter. char isAlphaNumeric ifTrue: [^true]. (self urlSpecials includes: aCharacter) ifTrue: [^true]. ^false.
</methods> <methods> OS.URLEncoder <category>accessing</category>
charset "Return a symbol indicating the encoding we will use." ^encoder encoding.
charset: aCharsetName encoder := StreamEncoder new: aCharsetName.
decodeHexNumberFrom: aStream ^Number readIntegerFrom: (aStream next: 2) readStream radix: 16.
encodingStream ^self encodingStreamOn: (WriteStream on: String new).
encodingStreamOn: innerStream | outerStream | outerStream := EncodedStream on: innerStream encodedBy: self. ^outerStream.
nextFrom: aStream "Decode the next byte(s) in the stream and answer the character." | c | c := aStream next. c = $+ ifTrue: [^Character space asInteger]. c = $% ifTrue: [^self decodeHexNumberFrom: aStream]. ^c isNil ifTrue: [c] ifFalse: [c asInteger].
nextPut: aCharacterOrByte on: aStream "Encode the character according to the encoding, and if necessary URL encode it" | digits digits2 aCharacter | aCharacter := aCharacterOrByte asCharacter. aCharacter = Character space ifTrue: [^aStream nextPut: $+]. "The doubling up is needing for encodings that switch character interpretations in the middle, using escape sequences. Specifically, JIS. Rather than hard-coding knowledge of these encodings, encode twice and if it's different, that means there's a prelude" digits := self bytesFor: aCharacter. digits2 := self bytesFor: aCharacter. digits size = digits2 size ifTrue: [(self isValidURLCharacter: aCharacter) ifTrue: [aStream nextPut: aCharacter] ifFalse: [digits do: [:each | self printHex: each on: aStream]]] ifFalse: [self printDigits: aCharacter withPreludeFor: digits and: digits2 on: aStream].
setEncoder: aCharacterEncoder encoder := aCharacterEncoder.
urlSpecials urlSpecials == nil ifTrue: [urlSpecials := self class urlSpecials]. ^urlSpecials.
urlSpecials: aString urlSpecials:= aString
</methods> <methods> OS.URLEncoder <category>private</category>
bytesFor: aCharacter | bitStream | bitStream := (ByteArray new: 8) writeStream. encoder nextPut: aCharacter on: bitStream. ^bitStream contents.
decodingStreamOn: aString | innerStream outerStream | innerStream := EncodedStream on: (ReadStream on: aString) encodedBy: self. outerStream := EncodedStream on: innerStream encodedBy: (self encoder ifNil: [UTF8StreamEncoder new]). ^outerStream.
printDigits: aCharacter withPreludeFor: bytesWithPrelude and: basicBytes on: aStream "This is used for encodings that switch character interpretations in the middle, using escape sequences. Specifically, JIS. Rather than hard-coding knowledge of these encodings, encode twice and if it's different, that means there's a prelude. Figure out what the prelude is and print it differently" | prelude preludeSize | preludeSize := bytesWithPrelude size - basicBytes size. prelude := bytesWithPrelude copyFrom: 1 to: preludeSize. prelude do: [:each | (self isValidURLCharacter: each asCharacter) ifTrue: [aStream nextPut: each asCharacter] ifFalse: [self printHex: each on: aStream]]. (self isValidURLCharacter: aCharacter) ifTrue: [ aStream nextPut: aCharacter] ifFalse: [basicBytes do: [:each | self printHex: each on: aStream]].
printDigitsNoPrelude: aCharacterOrDigit on: aStream | aCharacter | aCharacter := aCharacterOrDigit asCharacter. (self isValidURLCharacter: aCharacter) ifTrue: [ aStream nextPut: aCharacter] ifFalse: [self printHex: aCharacter asInteger on: aStream].
printHex: each on: aStream aStream nextPut: $%. ^each printOn: aStream base: 16 digitsToPad: 2 highDigit: 2.
</methods> <methods> OS.URLEncoder <category>status</category>
prepareToClose: aStream "This is truly horrible. We need to make a new stream, because we don't have the old one." | newStream | newStream := (ByteArray new: 5) writeStream. encoder prepareToClose: newStream. newStream contents do: [:each | self printDigitsNoPrelude: each on: aStream]. super prepareToClose: aStream.
</methods> <methods> OS.URLEncoder class <category>defaults</category>
defaultCharacterEncoder ^UTF8StreamEncoder new
urlSpecials urlSpecials isNil ifTrue: [urlSpecials := ' _']. ^urlSpecials.
</methods> <methods> OS.URLEncoder class <category>encoding</category>
decode: aString ^self new decode: aString.
encode: aString ^self new encode: aString.
</methods> <methods> OS.URLEncoder class <category>instance creation</category>
new ^super new initialize.
</methods> <methods> OS.URLEncoder class <category>accessing</category>
streamEncodingType ^#URL
</methods> <methods> OS.URI <category>comparing</category>
= aURI "Current implementation considers that two URLs: '<schema>://example.com/pub' and '<schema>://example.com/pub/' are not equivalent as they behave differently with respect to: #resolvePath:" ^self class = aURI class and: [self asString = aURI asString]
hash ^self asString hash
sameAs: aURI ^self = aURI
</methods> <methods> OS.URI <category>accessing</category>
asString ^self subclassResponsibility
asURI ^self
protocol ^self class protocol
protocol: p "Ignored by those protocols that only go by one name." ^self
resource ^self subclassResponsibility
</methods> <methods> OS.URI <category>stream creation</category>
binaryReadStream "Create a binary readStream on the data that the URI accesses. Some URIs such as MailTo will not support this." ^self subclassResponsibility
binaryWriteStream "Create a binary readStream on the data that the URI accesses. Some URIs such as MailTo will not support this." ^self subclassResponsibility
readStream ^(self withEncoding: #default) readStream
readStreamDo: aBlock "Create a binary readStream on the data that the URI accesses. Evaluate the block with the stream as the first argument, and with a Dictionary as the second argument. The Dictionary will describe any additional information that the protocol can supply about the resource, such as its file extension (using the key #extension) or its MIME type (using the key #MIME). This method is responsible for closing the stream after the block ends, as well as any other cleanup. Some URIs such as MailTo will not support this." ^self subclassResponsibility
withEncoding: aStreamEncoderName ^UriEncodedStreamConstructor on: self encoding: aStreamEncoderName
writeStream ^(self withEncoding: #default) writeStream
writeStreamDo: aBlock "Create a binary writeStream on the data that the URI accesses. Evaluate the block with the stream as the argument. This method is responsible for closing the stream after the block ends, as well as any other cleanup. Some URIs such as Http or News may not support this." ^self subclassResponsibility
</methods> <methods> OS.URI <category>private</category>
copyFromFTP: aURI self copyFromURI: aURI
copyFromURI: aURI self writeStreamDo: [:dest | aURI readStreamDo: [:src :parms | [src atEnd] whileFalse: [dest nextPutAll: (src nextAvailable: 1024)]]]
escaped: aString ^self class encode: aString
relativePathNotSupportedError self error: ((#RelativePathsAreNotSupported << #net >> 'Relative paths are not supported for the "<1s>" protocol') expandMacrosWith: self protocol)
</methods> <methods> OS.URI <category>utilities</category>
copyTo: aURI aURI asURI copyFromURI: self
</methods> <methods> OS.URI <category>resolution</category>
resolvePath: path ^(path includes: $:) ifTrue: [URI fromString: path] ifFalse: [self relativePathNotSupportedError]
</methods> <methods> OS.URI <category>printing</category>
printOn: aStream | str | str := [self asString] on: Error do: [:ex | ex return: nil]. str == nil ifTrue: [super printOn: aStream] ifFalse: [aStream nextPutAll: '<', str, '>'].
printProtocolOn: aStream aStream nextPutAll: self protocol, '://'.
</methods> <methods> OS.URI <category>testing</category>
isPartial ^false
</methods> <methods> OS.URI <category>deprecated</category>
resolveRelativePath: path " This method is now deprecated. pathString can be a PartialURL or a string and it will be judged as to whether it is relative or not by a leading /, eg: '/example.ext' asURI is absolute, while: 'example.ext' asURI is relative " self relativePathNotSupportedError
</methods> <methods> OS.URI class <category>accessing</category>
allowedChar ^self unreservedChar, ';?:@&=+$,'
autoloadFtp ^AutoloadFtp isNil ifTrue: [AutoloadFtp := false] ifFalse: [ AutoloadFtp ]
autoloadFtp: aBoolean AutoloadFtp := aBoolean
autoloadHttp ^AutoloadHttp isNil ifTrue: [AutoloadHttp := false] ifFalse: [ AutoloadHttp ]
autoloadHttp: aBoolean AutoloadHttp := aBoolean
autoloadHttps ^AutoloadHttps isNil ifTrue: [AutoloadHttps := false] ifFalse: [ AutoloadHttps ]
autoloadHttps: aBoolean AutoloadHttps := aBoolean
classForProtocol: aProtocol | prot class res | prot := aProtocol asLowercase. class := ProtocolToClassCache at: prot ifAbsent: []. (class ~~ nil and: [class protocol = prot]) ifTrue: [^class]. self allSubclasses do: [:cls | cls protocol = prot ifTrue: [^ProtocolToClassCache at: prot put: cls]]. ^(res := self tryToLoad: aProtocol) isNil ifTrue: [ UnknownURLType ] ifFalse: [ res ]
obsolete self resetProtocolToClassCache. super obsolete.
pathAllowedChars ^self unreservedChar, ':@&=+$,'
protocol ^self subclassResponsibility
reservedChar ^';/?:@&=+$,'
resetProtocolToClassCache "(self resetProtocolToClassCache)" ProtocolToClassCache keys do: [ :k | ProtocolToClassCache removeKey: k].
unreservedChar ^'-_.!~*''()'
userAllowedChars ^self unreservedChar, ';:&=+$,'
</methods> <methods> OS.URI class <category>instance creation</category>
fromString: aString "Error checking is somewhat minimal at this time." | index protocol data | (aString includes: $:) ifFalse: [^PartialURL fromString: aString]. index := aString indexOf: $:. protocol := aString copyFrom: 1 to: index-1. data := aString copyFrom: index+1 to: aString size. ^((self classForProtocol: protocol) fromString: data) protocol: protocol
</methods> <methods> OS.URI class <category>testing</category>
hasUnsafeChars: aString allowed: allowed | cCode | aString do: [:c | cCode := c asInteger. (cCode >= 32 and: [cCode <= 126 or: [allowed includes: c]]) ifFalse: [^true]]. ^false
shouldEncode: character allowed: allowed ^(allowed includes: character) not and: [character isAlphaNumeric not ]
</methods> <methods> OS.URI class <category>encoding/decoding</category>
decode: aString |str | str := (String new: aString size) writeStream. self decode: aString on: str. ^str contents
decode: aString errorMessage: message allowed: allowed ^(self hasUnsafeChars: aString allowed: allowed) ifTrue: [ self error: message ] ifFalse: [self decode: aString]
decode: aString on: stream | oldStr ch | oldStr := aString readStream. [oldStr atEnd] whileFalse: [ch := oldStr next. self decodeChar: ch from: oldStr to: stream]. ^stream contents
decodeChar: character from: stream to: outputStream | n c1 | n := 0. character = $% ifTrue: [2 timesRepeat: [c1 := stream next. c1 == nil ifTrue: [self error: (#IncompleteEscapeSequence << #net >> 'Incomplete escape sequence')] ifFalse: [c1 := c1 digitValue. (c1 between: 0 and: 15) ifFalse: [self error: (#DidntFindHexadecimalDigit << #net >> 'Didn''t find a hexadecimal digit')]. n := n * 16 + c1]]. outputStream nextPut: (Character value: n)] ifFalse: [ outputStream nextPut: character]
encode: aString ^self encode: aString allowed: self allowedChar.
encode: aString allowed: allowed | stream | stream := (String new: aString size) writeStream. self encode: aString on: stream allowed: allowed. ^stream contents
encode: aString on: stream self encode: aString on: stream allowed: self allowedChar
encode: aString on: stream allowed: allowed | hex ch | hex := '01234567890abcdefABCDEF'. 1 to: aString size do: [:ind | ch := aString at: ind. ((self shouldEncode: ch allowed: allowed) and: [ (ch =$% and: [ ind + 2 > aString size]) or: [ (ch = $% and: [(hex includes: (aString at: ind + 1)) and: [(hex includes: (aString at: ind + 2))]]) not]]) ifTrue: [stream nextPut: $%. ch asInteger printOn: stream paddedWith: $0 to: 2 base: 16] ifFalse: [stream nextPut: ch]].
</methods> <methods> OS.URI class <category>private</category>
loadNetParcel: aString autoload: aBoolean "FTP, HTTP and HTTPS parcels have to be in the ..\net directory" (LogicalFilename fromComponents: (Array with: '$(VISUALWORKS)' with: 'net' with: aString, '.pcl')) exists ifFalse: [^nil ]. ^aBoolean ifTrue: [ self loadParcel: aString ] ifFalse: [ComponentNotLoaded newException parameter: aString; defaultValueBlock: [ self loadParcel: aString ]; makeSureResumable; raiseSignal]
loadParcel: aString ^[ Parcel ensureLoadedParcel: aString withVersion: nil. self classForProtocol: aString ] on: Error do: [ :ex | ex return: nil ]
tryToLoad: protocolString ( 'http' match: protocolString) ifTrue: [ ^self loadNetParcel: 'HTTP' autoload: self autoloadHttp]. ( 'https' match: protocolString) ifTrue: [ ^self loadNetParcel: 'HTTPS' autoload: self autoloadHttps]. ( 'ftp' match: protocolString) ifTrue: [ ^self loadNetParcel: 'FTP' autoload: self autoloadFtp ]. ^nil
</methods> <methods> OS.URL <category>printing</category>
printOn: aStream | str | str := [self asString] on: Error do: [:ex | ex return: nil]. str == nil ifTrue: [super printOn: aStream] ifFalse: [aStream nextPutAll: '<URL:', str, '>'].
</methods> <methods> OS.URL class <category>accessing</category>
protocol ^'url'
</methods> <methods> OS.UnknownURLType <category>accessing</category>
asString ^protocol, ':', data
extraData: extraData data := extraData
protocol ^protocol
protocol: p protocol := p
resource ^self error: (#UnrecognizedTransferProtocol << #net >> 'Unrecognized transfer protocol')
</methods> <methods> OS.UnknownURLType class <category>instance creation</category>
fromString: aString "Error checking is somewhat minimal at this time." ^self new extraData: aString
</methods> <methods> OS.UnknownURLType class <category>accessing</category>
protocol ^nil
</methods> <methods> OS.ComponentNotLoaded <category>constants</category>
defaultResumeValue "Answer the default value to resume with." ^defaultValueBlock value
</methods> <methods> OS.ComponentNotLoaded <category>accessing</category>
defaultValueBlock: aBlock defaultValueBlock := aBlock
</methods> <methods> OS.ComponentNotLoaded <category>printing</category>
defaultMessageText ^(#CannotCreateURL << #net >> 'Can not create URL, <1s> parcel is not loaded') expandMacrosWith: self parameter
</methods> <methods> OS.ComponentNotLoaded class <category>testing</category>
mayResume ^true
</methods> <methods> OS.URLwithPath <category>resolution</category>
addComponent: aFileComponent aFileComponent = '..' ifTrue: [path isEmpty ifFalse: [path first ~= '..' ifTrue: [path := path copyFrom: 1 to: (path size-1 max: 0)] ifFalse: [self privateAddComponent: aFileComponent]]] ifFalse: [self privateAddComponent: aFileComponent]
construct: aFileComponent ^self copy addComponent: aFileComponent; yourself
removeLastComponent path := path copyFrom: 1 to: path size-1
resolvePath: aPath | aURI | aURI := aPath asURI. aURI isPartial ifFalse: [^aURI copy]. ^self copy mergePartial: aURI; yourself
withComponent: component "Create a new URL with the argument component appended. The new component is assumed to be already URL-encoded." | p | p := (self path isEmpty not and: [self path last = '']) ifTrue: [self path copyFrom: 1 to: self path size-1] ifFalse: [self path]. ^self copy query: nil; fragment: nil; path: p; addComponent: component
withComponents: comps "Create a new URL with the argument components appended. The new components are assumed to be already URL-encoded." | p uri | p := (self path isEmpty not and: [self path last = '']) ifTrue: [self path copyFrom: 1 to: self path size-1] ifFalse: [self path]. uri := self copy query: nil; fragment: nil; path: p. comps do: [:s | uri addComponent: s]. ^uri
withSimpleComponent: comp "Create a new URL with the argument component appended. The new component has not yet been URL-encoded, and this will be done before it is appended." ^self withComponent: comp
withSimpleComponents: comps "Create a new URL with the argument component appended. The new components have not yet been URL-encoded, and this will be done before they are appended." ^self withComponents: comps
</methods> <methods> OS.URLwithPath <category>utilities</category>
directory ^self withComponent: '..'
tail | index | path isEmpty ifTrue: [^'']. index := path last = '' ifTrue: [path size-1] ifFalse: [path size]. index = 0 ifTrue: [^'']. ^self pathAt: index
</methods> <methods> OS.URLwithPath <category>accessing</category>
fragment ^fragment
fragment: f fragment := f
path ^path
path: aPath path := aPath
pathAt: index | p | p := path at: index. ^self simpleValidate: p errorMessage: ((#InvalidPathComponent1s << #net >> 'Invalid path component: <1s>') expandMacrosWith: p) allowed: self class pathAllowedChars
query ^query
query: q query := q
</methods> <methods> OS.URLwithPath <category>private</category>
guessMimeType "To do move Net.MimeTypeDescriptor to base classes and return: Net.MimeTypeDescriptor contentType: mimeType" ^#{Net.MimeTypeDescriptor} ifDefinedDo: [ :mimeTypeDescriptor | mimeTypeDescriptor guessFromExtension: self tail asFilename extension] elseDo: ['text/plain']
mergeAbsolutePath: aPath self path: (aPath allButFirst: 1)
mergePartial: aPartialURL self fragment: aPartialURL fragment. aPartialURL hasNoPath ifTrue: [^aPartialURL query ifNotNil: [self query: aPartialURL query]]. self query: aPartialURL query. aPartialURL isAbsolute ifTrue: [self mergeAbsolutePath: aPartialURL path copy] ifFalse: [self mergeRelativePath: aPartialURL path copy]
mergeRelativePath: relativePath path isEmpty ifTrue: [^path := relativePath]. path := (path allButLast: 1), relativePath
privateAddComponent: aFileComponent path := path copyWith: (self class encode: aFileComponent allowed: self class pathAllowedChars)
protocolSignals
safelyExecuteBlock: aBlock ^aBlock value
simpleValidate: aString errorMessage: message allowed: allowed ^self class decode: aString errorMessage: message allowed: allowed
storeExtrasOn: aStream query == nil ifFalse: [aStream nextPutAll: '?', query]. fragment == nil ifFalse: [aStream nextPutAll: '#', fragment].
validateHost: aString | str parts | str := self simpleValidate: aString errorMessage: ((#InvalidHostName1s << #net >> 'Invalid host name: <1s>') expandMacrosWith: aString) allowed: ''. str do: [:ch | (ch isAlphaNumeric or: ['.-_' includes: ch]) ifFalse: [self error: ((#InvalidHostName1s << #net >> 'Invalid host name: <1s>') expandMacrosWith: aString)]]. parts := str tokensBasedOn: $.. parts do: [:str1 | str1 isEmpty ifTrue: [self error: ((#InvalidHostName1s << #net >> 'Invalid host name: <1s>') expandMacrosWith: aString)]. (str1 first = $- or: [str1 last = $-]) ifTrue: [self error: ((#InvalidHostName1s << #net >> 'Invalid host name: <1s>') expandMacrosWith: aString)]]. ^str
validatePassword: aString | str | str := self simpleValidate: aString errorMessage: ((#InvalidPassword1s << #net >> 'Invalid password: <1s>') expandMacrosWith: aString) allowed: self class userAllowedChars. ^str
validatePort: aString | str port | str := self simpleValidate: aString errorMessage: ((#InvalidPort1s << #net >> 'Invalid port: <1s>') expandMacrosWith: aString) allowed: ''. port := 0. str do: [:c | (c between: $0 and: $9) ifTrue: [port := port * 10 + c digitValue] ifFalse: [self error: ((#InvalidPort1s << #net >> 'Invalid port: <1s>') expandMacrosWith: aString).]]. ^port
validateUser: aString | str | str := self simpleValidate: aString errorMessage: ((#InvalidUser1s << #net >> 'Invalid user: <1s>') expandMacrosWith: aString) allowed: self class userAllowedChars. ^str
</methods> <methods> OS.URLwithPath <category>comparing</category>
sameAs: aURI "Current implementation considers that two URLs are equivalent only when their path size is equal and therefore the method returns false for URLs: '<schema>://example.com/pub' and '<schema>://example.com/pub/' " self path size = aURI path size ifFalse: [^false]. 1 to: self path size do: [ :ind | (self pathAt: ind) = (aURI pathAt: ind ) ifFalse: [ ^false ]]. ^true
</methods> <methods> OS.URLwithPath <category>printing</category>
printPathOn: aStream self path size = 0 ifTrue: [aStream nextPutAll: '/'] ifFalse: [1 to: self path size do: [ :ind | aStream nextPutAll: '/', (self pathAt: ind)]].
printPathStringOn: aStream path size = 0 ifTrue: [aStream nextPutAll: '/'] ifFalse: [path do: [:s | aStream nextPutAll: '/', s]].
</methods> <methods> OS.URLwithPath <category>converting</category>
, aURI ^self resolvePath: aURI
asPartial | stream | stream := String new writeStream. self printPathStringOn: stream. self storeExtrasOn: stream. ^PartialURL fromString: stream contents
</methods> <methods> OS.URLwithPath <category>copying</category>
postCopy super postCopy. path := path copy. query := query copy
</methods> <methods> OS.URLwithPath <category>deprecated</category>
resolveRelativePath: pathString " This method is now deprecated. pathString can be a PartialURL or a string and it will be judged as to whether it is relative or not by a leading /, eg: '/example.ext' asURI is absolute, while: 'example.ext' asURI is relative " ^self resolvePath: pathString
</methods> <methods> OS.URLwithPath class <category>instance creation</category>
fromString: aString "Error checking is somewhat minimal at this time." | index host path | ('//*' match: aString) ifFalse: [self error: (#URLDoesNotBeginWithProtocol << #net >> 'URL does not begin with "protocol://"')]. index := (3 to: aString size) detect: [:i | '/?#' includes: (aString at: i)] ifNone: []. index = nil ifTrue: [host := aString copyFrom: 3 to: aString size. path := ''] ifFalse: [host := aString copyFrom: 3 to: index-1. (aString at: index ) = $/ ifTrue: [path := aString copyFrom: index+1 to: aString size] ifFalse: [path := aString copyFrom: index to: aString size]]. ^self host: host pathString: path
host: aHost path: aPath ^(self newWithPath: aPath) parseHost: aHost; yourself
host: aHost pathString: aPath ^self resolvePath: aPath do: [:pList :qString :fString | (self host: aHost path: pList) query: qString; fragment: fString; yourself]
newWithPath: aCollection ^(self new path: (self encodePath: aCollection); yourself)
</methods> <methods> OS.URLwithPath class <category>accessing</category>
protocol ^nil
</methods> <methods> OS.URLwithPath class <category>encoding/decoding</category>
encodePath: aCollection ^aCollection collect: [ :component | self encode: component allowed: self pathAllowedChars ]
</methods> <methods> OS.URLwithPath class <category>private</category>
resolvePath: string do: aBlock | pString idx frag query list | pString := string. (pString includes: $#) ifTrue: [idx := pString indexOf: $#. frag := pString copyFrom: idx+1 to: pString size. pString := pString copyFrom: 1 to: idx-1] ifFalse: [frag := nil]. (pString includes: $?) ifTrue: [idx := pString indexOf: $?. query := pString copyFrom: idx+1 to: pString size. pString := pString copyFrom: 1 to: idx-1] ifFalse: [query := nil]. list := pString tokensBasedOn: $/. ^aBlock value: list value: query value: frag.
</methods> <methods> OS.PartialURL <category>testing</category>
hasNoPath ^path size = 1 and: [path first isEmpty]
isAbsolute ^path size > 1 and: [path first isEmpty]
isPartial ^true
</methods> <methods> OS.PartialURL <category>private</category>
mergeAbsolutePath: aPath self path: aPath
</methods> <methods> OS.PartialURL <category>printing</category>
printPathOn: aStream self path isEmpty ifTrue: [^self]. 1 to: self path size do: [ :ind | aStream nextPutAll: (self pathAt: ind); nextPutAll: '/']. aStream skip: -1
printPathStringOn: aStream self printPathOn: aStream
</methods> <methods> OS.PartialURL <category>accessing</category>
asString | stream | stream := String new writeStream. self printPathStringOn: stream. self storeExtrasOn: stream. ^stream contents
</methods> <methods> OS.PartialURL class <category>instance creation</category>
fromString: aString ^self resolvePath: aString do: [:pList :qString :fString | (self newWithPath: pList) query: qString; fragment: fString; yourself]
</methods> <methods> OS.URLwithAuthority <category>accessing</category>
asString | str | str := (String new: 64) writeStream. self printProtocolOn: str. self printAuthorityOn: str. ^str contents
client ^self subclassResponsibility
defaultPortNumber ^self class defaultPortNumber
host ^host
port ^port isNil ifTrue: [ port := self defaultPortNumber] ifFalse: [ port ]
</methods> <methods> OS.URLwithAuthority <category>comparing</category>
sameAs: aURI ^(super sameAs: aURI) and: [ ( host match: aURI host ) and: [ self port = aURI port ]]
</methods> <methods> OS.URLwithAuthority <category>initialize</category>
host: aString port: aNumber host := aString. port := aNumber.
parseHost: aHostSpecification self parseHostPort: aHostSpecification
parseHostPort: fullHost | idx pString | (fullHost includes: $:) ifTrue: [idx := fullHost indexOf: $:. host := self validateHost: (fullHost copyFrom: 1 to: idx-1). (pString := fullHost copyFrom: idx+1 to: fullHost size) isEmpty ifTrue: [ port := self defaultPortNumber ] ifFalse: [ port := self validatePort: pString ]] ifFalse: [host := self validateHost: fullHost. port := self defaultPortNumber]
</methods> <methods> OS.URLwithAuthority <category>printing</category>
printAuthorityOn: aStream aStream nextPutAll: host. self port ~= self defaultPortNumber ifTrue: [aStream nextPutAll: ':'; print: self port]. self printPathStringOn: aStream. self storeExtrasOn: aStream.
</methods> <methods> OS.UriEncodedStreamConstructor <category>streams</category>
appendStream "Answer a write stream connected to the file represented by the receiver." ^self notImplemented
newReadAppendStream "Answer a new readAppend stream connected to the file represented by the receiver." ^self notImplemented
newReadWriteStream "Answer a new readWrite stream connected to the file represented by the receiver." ^self notImplemented
readAppendStream "Answer a readAppend stream connected to the file represented by the receiver." ^self notImplemented
readStream "Answer a read stream connected to the file represented by the receiver." ^self addEncodingTo: dataRepository binaryReadStream
readWriteStream "Answer a readWrite stream connected to the file represented by the receiver." ^self notImplemented
writeStream "Answer a write stream connected to the file represented by the receiver." ^self addEncodingTo: dataRepository binaryWriteStream
</methods> <methods> OS.FileURL <category>resolution</category>
addComponent: aFileComponent self privateAddComponent: aFileComponent. self normalize
</methods> <methods> OS.FileURL <category>accessing</category>
asFilename | path2 fn | ^missingSlashes ifTrue: [self path asFilename] ifFalse: [path2 := (1 to: path size) collect: [:i | self pathAt: i]. host == nil ifTrue: [Filename rootComponents: path2] ifFalse: [fn := (Filename pathForRemoteHost: host) asFilename. path2 do: [:s | fn := fn construct: (fn class decodePortableComponent: s)]. fn]]
asFilename: filenameClass "Useful for doing testing" | path2 fn | ^missingSlashes ifTrue: [filenameClass named: self path] ifFalse: [path2 := (1 to: path size) collect: [:i | self pathAt: i]. host == nil ifTrue: [filenameClass rootComponents: path2] ifFalse: [fn := filenameClass named: (filenameClass pathForRemoteHost: host). path2 do: [:s | fn := fn construct: (fn class decodePortableComponent: s)]. fn]]
asString | str | str := (String new: 64) writeStream. ^missingSlashes ifTrue: [str nextPutAll: 'file:'; nextPutAll: self path asString. self storeExtrasOn: str. str contents] ifFalse: [str nextPutAll: 'file://'. host == nil ifFalse: [str nextPutAll: host]. str nextPutAll: '/'. path do: [:i | str nextPutAll: i] separatedBy: [str nextPutAll: '/']. self storeExtrasOn: str. str contents]
host: aHost host := aHost
missingSlashes: aBoolean missingSlashes := aBoolean
path: aPath super path: aPath. missingSlashes := false
resource ^XML.InputSource uri: self encoding: nil stream: (self asFilename withEncoding: #UTF_8) readStream lineEndTransparent
</methods> <methods> OS.FileURL <category>stream creation</category>
binaryReadStream ^(self asFilename withEncoding: #binary) readStream
binaryWriteStream ^(self asFilename withEncoding: #binary) writeStream
readStreamDo: aBlock | stream params | stream := (self asFilename withEncoding: #binary) readStream. params := Dictionary new. params at: #MIME put: self guessMimeType. ^[aBlock value: stream value: params] ensure: [stream close]
writeStreamDo: aBlock | stream | stream := (self asFilename withEncoding: #binary) writeStream. ^[aBlock value: stream] ensure: [stream close]
</methods> <methods> OS.FileURL <category>utilities</category>
delete self asFilename delete
fileSize ^self asFilename fileSize
makeDirectory self asFilename makeDirectory
tail ^self asFilename tail
</methods> <methods> OS.FileURL <category>file utilities</category>
directoryContents ^self asFilename directoryContents collect: [:s | self withSimpleComponent: s]
</methods> <methods> OS.FileURL <category>testing</category>
exists ^self asFilename exists
isDirectory ^self asFilename isDirectory
</methods> <methods> OS.FileURL <category>private</category>
normalize 2 to: path size do: [:i | ((path at: i) = '..' and: [(path at: i-1) ~= '.' and: [(path at: i-1) ~= '..']]) ifTrue: [path := (path copyFrom: 1 to: i-2), (path copyFrom: i+1 to: path size). ^self normalize]. (path at: i) = '.' ifTrue: [path := (path copyFrom: 1 to: i-1), (path copyFrom: i+1 to: path size). ^self normalize]].
</methods> <methods> OS.FileURL class <category>instance creation</category>
fromFilename: aFilename | p | p := aFilename uriComponents. ^(p respondsTo: #key) ifTrue: [ (self newWithPath: p value) host: p key; yourself] ifFalse:[self newWithPath: p]
fromString: aString "Error checking is somewhat minimal at this time." "Lame override of the superclass because tests supplied by Sun to OASIS use wierd syntax with file: protocol." "This approach puts a String in the path, which should only be a Filename. This is required to avoid canonicalizing the file name, but results in an URL that can do nothing other than answer the string which created it." ('//*' match: aString) ifFalse: [^self new path: aString; missingSlashes: true]. ^super fromString: aString
host: aHost path: aPath ^(#('' 'localhost') includes: aHost) ifTrue: [ self newWithPath: aPath] ifFalse: [ (self newWithPath: aPath) host: aHost; yourself ]
</methods> <methods> OS.FileURL class <category>accessing</category>
protocol ^'file'
</methods> <methods> OS.Filename class <category>private</category>
decodePortableComponent: aString "Translate portable path notation (which for example uses '..' to represent the parent directory) into the host equivalent" ^aString
</methods> <methods> OS.Filename <category>private</category>
uriComponents | list | list := (self class components: self asString) asArray. self isRelative ifTrue: [list := #('.'), list]. ^list
</methods> <methods> OS.Filename <category>converting</category>
asURI ^FileURL fromFilename: self
</methods> <methods> OS.MacFilename class <category>private</category>
decodePortableComponent: aString "Translate portable path notation (which for example uses '..' to represent the parent directory) into the host equivalent" ^aString = '..' ifTrue: [':'] ifFalse: [aString]
</methods> <methods> OS.UnixFilename <category>private</category>
uriComponents "#('/' '/a/b/c' 'a/b/c' '../a/b') collect: [:i || f | f := (UnixFilename named: i). f asString = (f asURI asFilename: UnixFilename) asString]" | list | list := super uriComponents. list size = 0 ifFalse: [list first = '/' ifTrue: [list := list copyFrom: 2 to: list size]]. ^list
</methods> <methods> OS.PCFilename <category>private</category>
uriComponents "#('\' '\a\b\c' 'a\b\c' 'c:\a\b' '\\romulan' '\\romulan\' '\\romulan\disk' '\\romulan\disk\' '\\romulan\disk\a' '..\a\b') collect: [:i || f | f := (PCFilename named: i). f asString = (f asURI asFilename: PCFilename) asString]" | list idx host | list := super uriComponents. list size = 0 ifFalse: [list first = '\' ifTrue: [list := list copyFrom: 2 to: list size] ifFalse: [('#:\' match: list first) ifTrue: [list at: 1 put: (list first copyWithout: $\)] ifFalse: [('\\*\*\' match: list first) ifTrue: [idx := list first nextIndexOf: $\ from: 3 to: list first size. host := list first copyFrom: 3 to: idx-1. list at: 1 put: (list first copyFrom: idx+1 to: list first size-1). list := host -> list] ifFalse: [('\\*\' match: list first) ifTrue: [host := list first copyFrom: 3 to: list first size-1. list := host -> (list copyFrom: 2 to: list size)]]]]]. ^list
</methods> <methods> OS.Filename class <category>instance creation</category>
rootComponents: path "Answer a new Filename with the supplied path. Unless the first element of the path explicitly specifies the local directory as the starting point of the path, the resulting name should be modified to be an absolute path name. For portability, '.' will be used to specify the local directory as the starting point, even though on Mac OS and possibly others a different convention is used. Using '.' allows the path to refer to relative path names in a platform independent way." | stream filename | path isEmpty ifTrue: [^self concreteClass fromRootComponent: '']. stream := path readStream. filename := self concreteClass fromRootComponent: stream next. [stream atEnd] whileFalse: [filename := filename construct: (self concreteClass decodePortableComponent: stream next)]. ^filename
</methods> <methods> OS.MacFilename <category>private</category>
uriComponents "Some of the following examples will answer false, if the MacFilename ends in a colon which can safely be removed, the URI will remove that colon. #('a:b:c' 'a:b:c:' ':a' 'a' ':a:b:c' ':a:b:c:' ':::a:b:c') collect: [:i || f | f := (MacFilename named: i). f asString = (f asURI asFilename: MacFilename) asString]" | list | list := super uriComponents. list size = 0 ifFalse: [(list size > 1 and: [list first = '.' and: [(list at: 2) = ':']]) ifTrue: [list := #('.'), (list copyFrom: 3 to: list size)]. list := list collect: [:s | s copyWithout: $:]. list replaceAll: '' with: '..']. ^list
</methods> <methods> Core.CharacterArray <category>converting</category>
asURI "Answer a URI named the receiver." ^URI fromString: self string
</methods> "Imported Classes:" self error: 'Attempting to file-in parcel imports. Choose terminate or close' <class> <name>Object</name> <environment>Core</environment> <super></super> <private>false</private> none <imports></imports> <category>Kernel-Objects</category> <attributes> <package>Kernel-Objects</package> </attributes> </class> <class> <name>CharacterArray</name> <environment>Core</environment> <super>Core.ArrayedCollection</super> <private>false</private> none <imports></imports> <category>Collections-Text</category> <attributes> <package>Collections-Text</package> </attributes> </class> <class> <name>Filename</name> <environment>OS</environment> <super>Core.Object</super> <private>false</private> none osName publicName logicalName <imports></imports> <category>OS-Support</category> <attributes> <package>OS-Support</package> </attributes> </class> <class> <name>EncodedStreamConstructor</name> <environment>Core</environment> <super>Core.Object</super> <private>false</private> none dataRepository encoding <imports></imports> <category>Collections-Streams</category> <attributes> <package>Collections-Streams</package> </attributes> </class> <class> <name>PCFilename</name> <environment>OS</environment> <super>OS.Filename</super> <private>false</private> none <imports></imports> <category>OS-PC</category> <attributes> <package>OS-PC</package> </attributes> </class> <class> <name>Exception</name> <environment>Core</environment> <super>Core.GenericException</super> <private>false</private> none <imports></imports> <category>Kernel-Exception Handling</category> <attributes> <package>Kernel-Exception Handling</package> </attributes> </class> <class> <name>MacFilename</name> <environment>OS</environment> <super>OS.Filename</super> <private>false</private> none <imports></imports> <category>OS-Mac</category> <attributes> <package>OS-Mac</package> </attributes> </class> <class> <name>StreamEncoder</name> <environment>Core</environment> <super>Core.Object</super> <private>false</private> none encoder errorPolicy skipRecord <imports></imports> <category>Collections-Streams</category> <attributes> <package>Collections-Streams</package> </attributes> </class> <class> <name>UnixFilename</name> <environment>OS</environment> <super>OS.Filename</super> <private>false</private> none <imports></imports> <category>OS-Unix</category> <attributes> <package>OS-Unix</package> </attributes> </class>