--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/FileURI.st	Thu Jan 17 15:25:48 2002 +0100
@@ -0,0 +1,116 @@
+"{ Package: 'stx:libbasic2' }"
+
+HierarchicalURI subclass:#FileURI
+	instanceVariableNames:''
+	classVariableNames:''
+	poolDictionaries:''
+	category:'Resources'
+!
+
+
+!FileURI class methodsFor:'instance creation'!
+
+fromFilename:aFilename
+    "create an URI based on an a filename"
+
+    ^ self new fromFilename:aFilename
+! !
+
+!FileURI class methodsFor:'accessing'!
+
+schemes
+    "answer the list of supported schemes"
+
+    ^ #(file)
+! !
+
+!FileURI methodsFor:'converting'!
+
+asFilename
+    "answer the receiver represented as filename"
+
+    ^ authority notNil ifTrue:[
+        Filename remoteHost:authority rootComponents:pathSegments.
+    ] ifFalse:[
+        Filename rootComponents:pathSegments
+    ].
+! !
+
+!FileURI methodsFor:'initialize'!
+
+fromFilename:aFilename
+    "create an URI based on an a filename"
+
+    |components|
+
+    components := aFilename components.
+    aFilename isAbsolute ifTrue:[
+        (components size > 3 and:[(components at:2) size == 0]) ifTrue:[
+            "this is a MS-Windows network path: \\host\path"
+            authority := components at:3.
+            pathSegments := components copyFrom:4.
+        ] ifFalse:[
+            "this is an absolute path"
+            isAbsolute := true.
+            pathSegments := components copyFrom:2.
+        ].
+    ] ifFalse:[
+        "this is a relative path"
+        isAbsolute := false.
+        pathSegments := components.
+    ]
+
+    "
+      self fromFilename:'/a/b/c' asFilename
+      self fromFilename:'//a/b/c' asFilename
+      self fromFilename:'a/b/c' asFilename
+    "
+! !
+
+!FileURI methodsFor:'stream access'!
+
+readStream
+
+    ^ self asFilename readStream
+
+    "
+     'file:/etc/group' asURI readStream contents
+    "
+!
+
+readStreamDo:aBlock
+    "evaluate a block with the read stream as first argument
+     and a dictionary containing attributes as second argument.
+     The stream is closed after aBlock has been evaluated."
+
+    |stream|
+
+    ^ [
+        |stream attributes|
+
+        stream := self asFilename readStream.
+        attributes := Dictionary new at:#MIME put:'text/plain'.
+        aBlock value:stream value:attributes
+     ] ensure:[
+        stream notNil ifTrue:[stream close]
+     ].
+
+    "
+     'file:/etc/group' asURI readStreamDo:[:stream :attributes|
+        stream contents         
+                addFirst:attributes printString; 
+                yourself
+     ].
+    "
+!
+
+writeStream
+
+    ^ self asFilename writeStream
+! !
+
+!FileURI class methodsFor:'documentation'!
+
+version
+    ^ '$Header: /cvs/stx/stx/libbasic2/FileURI.st,v 1.1 2002-01-17 14:24:59 stefan Exp $'
+! !

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/FtpURI.st	Thu Jan 17 15:25:48 2002 +0100
@@ -0,0 +1,70 @@
+"{ Package: 'stx:libbasic2' }"
+
+HierarchicalURI subclass:#FtpURI
+	instanceVariableNames:''
+	classVariableNames:''
+	poolDictionaries:''
+	category:'Resources'
+!
+
+
+!FtpURI class methodsFor:'accessing'!
+
+schemes
+
+    ^ #(ftp)
+! !
+
+!FtpURI methodsFor:'defaults'!
+
+defaultPassword
+
+    ^ 'secret@secret'
+!
+
+defaultPort
+    "answer the default command-port here"
+
+    ^ 21
+!
+
+defaultUser
+
+    ^ 'anonymous'
+! !
+
+!FtpURI methodsFor:'stream access'!
+
+readStreamDo:aBlock
+    "use FTPClient for now"
+
+    |ftp stream|
+
+    ftp := FTPClient new.
+    [
+        ftp connectTo:self host 
+            port:self port 
+            user:(self user ? self defaultUser)
+            password:(self password ? self defaultPassword).
+        stream := ftp getStreamFor:self path.
+        aBlock value:stream value:(Dictionary new at:#MIME put:'text/plain').
+    ] ensure:[
+        stream notNil ifTrue:[
+            stream close.
+        ].
+        ftp notNil ifTrue:[
+            ftp close.
+        ].
+    ]
+    "
+     'ftp://stefan:mschrat.14@hippo/etc/group' asURI readStreamDo:[:stream :attributes | 
+         self halt
+      ].
+    "
+! !
+
+!FtpURI class methodsFor:'documentation'!
+
+version
+    ^ '$Header: /cvs/stx/stx/libbasic2/FtpURI.st,v 1.1 2002-01-17 14:25:12 stefan Exp $'
+! !

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/HierarchicalURI.st	Thu Jan 17 15:25:48 2002 +0100
@@ -0,0 +1,405 @@
+"{ Package: 'stx:libbasic2' }"
+
+URI subclass:#HierarchicalURI
+	instanceVariableNames:'authority isAbsolute pathSegments query fragment'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'Resources'
+!
+
+!HierarchicalURI class methodsFor:'documentation'!
+
+documentation
+"
+    Hierarchical URI as defined in RFC2396:
+
+    <scheme:[//authority][/absolute_path][?query][#fragment]>
+
+    [author:]
+        Stefan Vogel (stefan@zwerg)
+
+    [see also:]
+
+    [instance variables:]
+
+    [class variables:]
+"
+!
+
+examples
+"
+
+  more examples to be added:
+                                                                [exBegin]
+    ... add code fragment for 
+    ... executable example here ...
+                                                                [exEnd]
+"
+! !
+
+!HierarchicalURI class methodsFor:'instance creation'!
+
+new
+
+    ^ self basicNew initialize
+!
+
+scheme:aSchemeString fromString:aString
+    "parse the hierarchical information.
+     schemeString is ignored here"
+
+    ^ self new scheme:aSchemeString; 
+               fromString:aString
+! !
+
+!HierarchicalURI methodsFor:'accessing'!
+
+authority
+    "return the value of the instance variable 'authority' (automatically generated)"
+
+    ^ authority
+!
+
+authority:something
+    "set the value of the instance variable 'authority' (automatically generated)"
+
+    authority := something.
+!
+
+fragment
+    "return the value of the instance variable 'fragment' (automatically generated)"
+
+    ^ fragment
+!
+
+fragment:something
+    "set the value of the instance variable 'fragment' (automatically generated)"
+
+    fragment := something.
+!
+
+isAbsolute
+    "return the value of the instance variable 'isAbsolute' (automatically generated)"
+
+    ^ isAbsolute
+!
+
+pathSegements
+    "return the value of the instance variable 'pathSegements' (automatically generated)"
+
+    ^ pathSegments
+!
+
+pathSegements:something
+    "set the value of the instance variable 'pathSegements' (automatically generated)"
+
+    pathSegments := something.
+!
+
+query
+    "return the value of the instance variable 'query' (automatically generated)"
+
+    ^ query
+!
+
+query:something
+    "set the value of the instance variable 'query' (automatically generated)"
+
+    query := something.
+! !
+
+!HierarchicalURI methodsFor:'accessing-details'!
+
+host
+    "answer the host part of authority"
+
+    |start end|
+
+    authority isNil ifTrue:[
+        ^ nil
+    ].
+    start := (authority indexOf:$@) + 1.
+    end := (authority indexOf:$: startingAt:start) - 1.
+    end == -1 ifTrue:[
+        end := authority size
+    ].
+    ^ authority copyFrom:start to:end
+
+    "
+      (self fromString:'ftp://stefan@www.exept.de:80/test') host
+      (self fromString:'ftp://www.exept.de:80/test') host
+      (self fromString:'ftp://www.exept.de/test') host
+    "
+!
+
+password
+    "answer the user part of authority"
+
+    |end start|
+
+    authority isNil ifTrue:[
+        ^ nil
+    ].
+    end := authority indexOf:$@.
+    end == 0 ifTrue:[
+        ^ nil
+    ].
+    start := authority indexOf:$:.
+    (start == 0 or:[start > end]) ifTrue:[
+        ^ nil
+    ].
+    ^ authority copyFrom:start+1 to:end-1
+
+    "
+      (self fromString:'ftp://stefan@www.exept.de:80/test') password
+      (self fromString:'ftp://stefan:pass@www.exept.de:80/test') password
+      (self fromString:'ftp://www.exept.de:80/test') password
+    "
+!
+
+port
+    "answer the port part of authority"
+
+    |start|
+
+    authority isNil ifTrue:[
+        ^ self defaultPort
+    ].
+    start := authority indexOf:$@.
+    start := authority indexOf:$: startingAt:start.
+    start == 0 ifTrue:[
+        ^ self defaultPort
+    ].
+
+    ^ authority copyFrom:start+1
+
+    "
+      (self fromString:'ftp://stefan@www.exept.de:80/test') port
+      (self fromString:'ftp://www.exept.de:80/test') port
+      (self fromString:'ftp://www.exept.de/test') port
+    "
+!
+
+user
+    "answer the user part of authority"
+
+    |end end1|
+
+    authority isNil ifTrue:[
+        ^ nil
+    ].
+    end := authority indexOf:$@.
+    end == 0 ifTrue:[
+        ^ nil
+    ].
+    end1 := authority indexOf:$:.
+    end1 ~~ 0 ifTrue:[
+        end := end min:end1.
+    ].
+    ^ authority copyTo:end-1
+
+    "
+      (self fromString:'ftp://stefan@www.exept.de:80/test') user
+      (self fromString:'ftp://stefan:pass@www.exept.de:80/test') user
+      (self fromString:'ftp://www.exept.de:80/test') user
+    "
+! !
+
+!HierarchicalURI methodsFor:'defaults'!
+
+defaultPort
+   "answer the default port for the given scheme.
+    Concrete subclasses redefine this method"
+
+   ^ nil
+! !
+
+!HierarchicalURI methodsFor:'escape'!
+
+unEscape
+    "convert escaped characters (such as %20 for ' ') to their native
+     representation"
+
+    authority := self class unEscape:authority readStream.
+    pathSegments keysAndValuesDo:[:i :v|
+        pathSegments at:i put:(self class unEscape:v readStream).
+    ].
+    query := self class unEscape:query readStream.
+    fragment := self class unEscape:fragment readStream.
+! !
+
+!HierarchicalURI methodsFor:'initialize'!
+
+fromString:aString
+
+    |i i1 separator|
+
+    (aString startsWith:'//') ifTrue:[
+        i := aString indexOfAny:'/?#' startingAt:3.
+        i == 0 ifTrue:[
+            authority := aString copyFrom:3.
+            ^ self.
+        ] ifFalse:[
+            separator := aString at:i.
+            authority := aString copyFrom:3 to:i-1.
+        ].
+        isAbsolute := true.
+    ] ifFalse:[
+        (isAbsolute := aString startsWith:$/) ifTrue:[
+            i := 1.
+        ] ifFalse:[
+            i := 0.
+        ]
+    ].
+
+    [
+        i1 := aString indexOfAny:'/?#' startingAt:i+1.
+        i1 == 0 ifTrue:[
+            pathSegments add:(aString copyFrom:i+1).
+            ^ self.
+        ] ifFalse:[
+            separator := aString at:i1.
+            pathSegments add:(aString copyFrom:i+1 to:i1-1).
+            i := i1.
+        ].
+    ] doWhile:[separator == $/].
+
+    separator == $? ifTrue:[
+        i1 := aString indexOf:$# startingAt:i+1.
+        i1 == 0 ifTrue:[
+            query := aString copyFrom:i+1.
+            ^ self.
+        ] ifFalse:[
+            separator := aString at:i1.
+            query := aString copyFrom:i+1 to:i1-1.
+            i := i1.
+        ].
+    ].
+    separator == $# ifTrue:[
+        fragment := aString copyFrom:i+1.
+    ].
+        
+    "
+     self new fromString:'//authority/path1/path2'
+     self new fromString:'//authority/path1/path2?query'
+     self new fromString:'//authority/path1/path2?query#fragment'
+     self new fromString:'/path1/path2?query#fragment'
+     self new fromString:'/path1/path2#fragment'
+     self new fromString:'path1/path2#fragment'
+    "    
+!
+
+initialize
+
+    pathSegments := OrderedCollection new.
+! !
+
+!HierarchicalURI methodsFor:'printing & storing'!
+
+path
+    "answer the path part of the URI"
+
+    |aStream|
+
+    aStream := WriteStream on:''.
+
+    pathSegments size ~~ 0 ifTrue: [
+        isAbsolute ifTrue:[
+            aStream nextPut:$/.
+        ].
+        pathSegments do:[:p|
+            self class escape:p allow:';:@&=+",' on:aStream
+        ] separatedBy:[
+            aStream nextPut:$/
+        ].
+    ].
+    query notNil ifTrue: [
+        aStream nextPut:$?.
+        self class escape:query allow:nil on:aStream
+    ].
+    fragment notNil ifTrue: [
+        aStream nextPut:$#.
+        self class escape:fragment allow:nil on:aStream
+    ].
+
+    ^ aStream contents
+!
+
+printOn:aStream
+
+    self printOn:aStream escape:false
+!
+
+printOn:aStream escape:doEscape
+    "print the URI on aStream. If doEscape is set, escape special
+     characters"
+
+    super printOn:aStream.
+    authority notNil ifTrue: [
+        aStream nextPutAll:'//'.
+        doEscape ifTrue:[
+            self class escape:authority allow:'$,;:@&=+' on:aStream
+        ] ifFalse:[
+            aStream nextPutAll:authority
+        ]
+    ].
+    pathSegments size ~~ 0 ifTrue: [
+        isAbsolute ifTrue:[
+            aStream nextPut:$/.
+        ].
+        pathSegments do:[:p|
+            doEscape ifTrue:[
+                self class escape:p allow:';:@&=+",' on:aStream
+            ] ifFalse:[
+                aStream nextPutAll:p
+            ]
+        ] separatedBy:[
+            aStream nextPut:$/
+        ].
+    ].
+    query notNil ifTrue: [
+        aStream nextPut:$?.
+        doEscape ifTrue:[
+            self class escape:query allow:nil on:aStream
+        ] ifFalse:[
+            aStream nextPutAll:query
+        ]
+
+    ].
+    fragment notNil ifTrue: [
+        aStream nextPut:$#.
+        doEscape ifTrue:[
+            self class escape:fragment allow:nil on:aStream
+        ] ifFalse:[
+            aStream nextPutAll:fragment
+        ]
+    ].
+! !
+
+!HierarchicalURI methodsFor:'resolution'!
+
+addComponent:aString
+    "concatenate aString to my path"
+
+    (aString = '..' 
+     and:[pathSegments size ~~ 0 
+     and:[pathSegments first ~= '..']]) ifTrue:[
+        pathSegments removeLast.
+    ] ifFalse:[
+        pathSegments add:aString
+    ].
+!
+
+construct:aString
+    "concatenate anUri to my path"
+
+    ^ self copy 
+        addComponent:aString;
+        yourself.
+! !
+
+!HierarchicalURI class methodsFor:'documentation'!
+
+version
+    ^ '$Header: /cvs/stx/stx/libbasic2/HierarchicalURI.st,v 1.1 2002-01-17 14:25:25 stefan Exp $'
+! !

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/HttpURI.st	Thu Jan 17 15:25:48 2002 +0100
@@ -0,0 +1,56 @@
+"{ Package: 'stx:libbasic2' }"
+
+HierarchicalURI subclass:#HttpURI
+	instanceVariableNames:''
+	classVariableNames:''
+	poolDictionaries:''
+	category:'Resources'
+!
+
+
+!HttpURI class methodsFor:'accessing'!
+
+schemes
+
+    ^ #(http)
+! !
+
+!HttpURI methodsFor:'defaults'!
+
+defaultPort
+
+    ^ 80
+! !
+
+!HttpURI methodsFor:'stream access'!
+
+readStreamDo:aBlock
+    "use HTTPInterface for now"
+
+    |response headerInfo mime|
+
+    response := HTTPInterface get:self path 
+                    fromHost:self host 
+                    port:self port
+                    accept:#('*/*')  
+                    fromDocument:nil.
+
+    headerInfo := response headerInfo.
+    mime := headerInfo at:'content-type' ifAbsent:nil.
+    mime notNil ifTrue:[
+        headerInfo at:#MIME put:mime.
+    ].
+    aBlock value:response data readStream value:headerInfo
+
+    "
+     'http://www.exept.de/' asURI readStreamDo:[:stream :attributes | 
+         self halt
+      ].
+    "
+! !
+
+!HttpURI class methodsFor:'documentation'!
+
+version
+    ^ '$Header: /cvs/stx/stx/libbasic2/HttpURI.st,v 1.1 2002-01-17 14:25:37 stefan Exp $'
+! !

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/URI.st	Thu Jan 17 15:25:48 2002 +0100
@@ -0,0 +1,183 @@
+"{ Package: 'stx:libbasic2' }"
+
+Object subclass:#URI
+	instanceVariableNames:'scheme'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'Resources'
+!
+
+
+!URI class methodsFor:'instance creation'!
+
+fromString:aString
+    "create an URI from a given String"
+
+    |i scheme rest|
+
+    i := aString indexOf:$:.
+    i == 0 ifTrue:[
+        self error:'missing scheme in URI'
+    ].
+    scheme := aString copyFrom:1 to:i-1.
+    rest := aString copyFrom:i+1.
+    ^ (self classForScheme:scheme) scheme:scheme fromString:rest
+! !
+
+!URI class methodsFor:'accessing'!
+
+classForScheme:aString
+    "find a class for a given scheme name aString"
+
+    |s|
+
+    s := aString asLowercase.
+
+    ^ self allSubclasses detect:[:cls| |schemes|
+        schemes := cls schemes.
+        schemes size ~~ 0 and:[schemes includes:s]
+    ] ifNone:[HierarchicalURI]
+!
+
+schemes
+    "answer the schemes supported by an URI-class.
+     Concrete subclasses redefine this to answer an array of scheme names"
+
+    ^ nil
+! !
+
+!URI class methodsFor:'escape'!
+
+escape:aString allow:additionalCharacters on:aStream
+
+    |val|
+
+    aString do:[:c|
+        ((c isLetterOrDigit) 
+         or:[('-_.!!~*''()' includes:c) 
+         or:[additionalCharacters notNil 
+             and:[additionalCharacters includes:c]]]
+        ) ifTrue:[
+            aStream nextPut:c
+        ] ifFalse:[
+            val := c asciiValue.            
+            aStream nextPut:$%; 
+                    nextPut:(Character digitValue:val//16);
+                    nextPut:(Character digitValue:val\\16).
+        ].
+    ].
+        
+
+    "
+     self escape:'0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ'
+          allow:nil on:TextCollector open
+
+     self escape:'Ein text mit blanks und @ & #' 
+          allow:nil on:TextCollector open
+    "  
+!
+
+unEscape:aStream
+    "convert escape sequences to the original characters"
+
+    |s c1 c2|
+
+    s := WriteStream on:''.
+
+    [aStream atEnd] whileFalse:[
+        c1 := aStream next.
+        c1 == $% ifTrue:[
+            c1 := aStream next.
+            c1 isNil ifTrue:[
+                self error:'escape sequence incomplete'
+            ].
+            c2 := aStream next.
+            c2 isNil ifTrue:[
+                self error:'escape sequence incomplete'
+            ].
+            c1 := c1 digitValue.
+            c2 := c2 digitValue.
+            (c1 > 15 or:[c2 > 15]) ifTrue:[
+                self error:'escape sequence: expect hex digit'
+            ].
+            c1 := Character value:c1*16 + c2.
+        ].
+        s nextPut:c1.
+    ].
+
+    ^ s contents.
+
+    "
+     self unEscape:(self escape:'   &%@   ' allow:nil) readStream
+    "
+! !
+
+!URI methodsFor:'accessing'!
+
+scheme
+    "return primary scheme of the class.
+     Concrete subclasses may redefine this"
+
+    |schemes|
+
+    schemes := self class schemes.
+    ^ schemes size ~~ 0 ifTrue:[
+        schemes at:1
+    ] ifFalse:[
+        nil
+    ]
+!
+
+scheme:aString
+    "set the scheme. This is a noop here and may be 
+     defined by subclasses"
+
+    ^ self
+! !
+
+!URI methodsFor:'comparing'!
+
+= anURI
+    ^ self class == anURI class and:[self asString == anURI asString]
+!
+
+hash
+    ^ self asString hash
+! !
+
+!URI methodsFor:'converting'!
+
+asURI
+
+    ^ self
+! !
+
+!URI methodsFor:'printing & storing'!
+
+printOn:aStream
+
+    |scheme|
+
+    scheme := self scheme.
+    scheme size ~~ 0 ifTrue:[
+        aStream nextPutAll:scheme; nextPut:$:
+    ].
+! !
+
+!URI methodsFor:'subclass responsibility'!
+
+readStreamDo:aBlock
+
+    "evaluate a block with the read stream as first argument
+     and a dictionary containing attributes as second argument.
+     The stream is closed after aBlock has been evaluated.
+     Attributes may be the mime type (key #MIME)"
+
+    ^ self subclassResponsibility
+! !
+
+!URI class methodsFor:'documentation'!
+
+version
+    ^ '$Header: /cvs/stx/stx/libbasic2/URI.st,v 1.1 2002-01-17 14:25:48 stefan Exp $'
+! !